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ABSTRACT 


DISOSS/370 provides document library and distribution services for a range of 
intelligent subsystems (DISOSS/8100, Displaywriter, 5520, Scanmaster and 
DISOSS/PS) which support the IBM document handling architectures DIA and 
DCA. 


This book examines the feasibility of extending these document filing and dis- 
tribution functions to the various other intelligent devices that do not support 
DIA and DCA; the assumption is that, although these devices are often not pri- 
marily office systems, their users would nevertheless benefit from being able to 
use a company-wide electronic mail distribution system. 


The purpose is to show what can be done with currently available products, and 


the book includes an example showing how documents can be exchanged between 
DISOSS and PROFS. 


Abstract iil 
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PREFACE 


This document is the result of a Residency Project conducted at the Raleigh 
International Systems Centre. The purpose of the project was to study the prob- 
lem of connecting non-DIA systems to DISOSS, and to develop design guidelines 
for the use of anyone wishing to implement such a connection. 


There are four major parts: 


e "Introduction and Design Overview" on page 3 describes the objectives of 
the project, summarises the design options we considered, and provides an 
overview of the suggested system design. 


e "System Structure" on page 19 describes in detail the components of the 
proposed system. 


e "Sample System Implementation” on page 27, "System Definitions for the 
Sample Implementation" on page 47, and "Communicating Between PROFS 
and DISOSS" on page 53 describe our sample implementation of the proposed 
system. 


¢ "Sample System Components” on page 67, "API and DIU-build Subroutines” 
on page 105 and "Sample EXECs for the ‘CMS and PROFS User" on page 155 
contain listings of the programs used in the sample implementation. 


Anyone contemplating the possibility of attaching non- DIA systems to DISOSS 
should find the "Introduction and Design Overview" on page 3 useful. The 
remaining chapters are intended for systems designers and programmers 
responsible for the design and implementation of such interfaces. 


RELATED PUBLICATIONS 


$C30-3096 DISOSS/370 Version 3 Application Programming 
GG24-1614 DISOSS Application Interface: Programming Guidelines 
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ABBREVIATIONS 


Certain terms widely used in this document should be understood as follows: 


JES 


Box X 


L2DCA 


Refers to Job Entry Subsystems in general, and should be taken to 
include VSE/POWER, OS/VS1 RES, MVS/JES2 and MVS/JES3, except 
where otherwise stated. | 


Refers to the subsystem wishing to communicate with DISOSS. Where 
there is no need to distinguish between the various real systems 
(VM/SP, S/34, DPPX etc.), we will often use the term ‘Box X' to 
apply to them all. ? : | 


Refers to the Level 2 Document Content Architecture. This is also 
known as the Final Form Text DCA, or FFT, and is defined in Docu- 
ment Content Architecture: Final-Form-Text Reference, S$C23-0757. 
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1.0 INTRODUCTION AND DESIGN OVERVIEW 


The Document Interchange Architecture (DIA) defines a set of rules (or ‘proto- 
cols'), allowing two programs to hold a ‘conversation’; the purpose of this con- 
versation is to exchange documents, together with commands describing what is 
to be done with these documents. DIA defines the ‘language the two programs 
use to exchange documents and control requests, but it is not concerned with 
the means by which these requests are moved from one program to the other. 
Typically, the transport function is provided by an SNA network; DIA does not 
duplicate any SNA function, and could theoretically use any transport mech- 
anism that provides appropriate levels of reliability, recovery etc. 


DISOSS exists to provide document handling functions, and to cooperate in this 
with intelligent devices such as 8100/DOSF, Displaywriter, 5520 and Scanmas- 
ter; hence it is logical that DISOSS ‘converses’ with these systems using exclu- 
sively the DIA protocols. ? 


DISOSS/370 V3R1 provides an Application Program Interface (API), which allows 
user-written CICS applications to use the DIA protocols to exchange documents 
and commands with DISOSS. In this case, since the user program and DISOSS 
are both executing under CICS, the transport mechanism for moving requests 
between them is not an SNA network but internal CICS and DISOSS facilities; 
however, the DIA protocols remain unchanged from those used to communicate 
between DISOSS and its other subsystems. 


The API provides a means of interfacing almost any system to DISOSS in a man- 
ner that does not require modifications to the product, and should be safe from 
the effects of changes in future releases. Ciearly, then, it is fundamental to 
any ene to make DISOSS functions available to devices not directly sup- 
ported. 


The remainder of this chapter describes the basic characteristics of our pro- 
posed system design, and explains the logic that led us to that design rather 
than one of the many alternatives. 


Note that DISOSS does not communicate with the end-user, but with a pro- 


gram executing in the subsystem; it is the intelligent subsystem that pro- 
vides end-user interfaces appropriate to the type of user it supports. 
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1.1 DESIGN OBJECTIVES 


Our principal aim was to disceek whether it was possible to design a system 
that embodied two fundamental characteristics: 


e General Applicability 
e Ease of Implementation 


There was always the real possibility that these two characteristics would prove 
to be mutually exclusive, and so to make our aims more precise, we defined the. 
following requirements of the design: | 


Generality 


It should provide a generalised interface to DISOSS that could be used by the 
majority of systems installed in today's networks, including, but not limited to: 


VM/SP (and thus PROFS) 
S/34, S/36, S$/38 
8100/DPPX 

Series/1 

5280 

PC 


e@e06¢6688 CU 


In addition, it must be structured so that an IBM customer could implement it 
without unreasonable difficulty or risk. This leads to the following three 
requirements. | | ; | 
Minimum New Code 


It should make every possible use of existing products and functions, rather 
than demanding new ones specifically designed for the purpose. 


Resilience 

It must require no modifications to |BM-supported software. 

Programming Skills | 

It should aim to avoid highly specialised or complex techniques and system 


interfaces, and should aim to use only those programming skills which are gen- 
erally available in customer installations. | 


1.2 LOGIC OF THE DESIGN PROCESS 
Given the objectives listed above, several major design decisions must be 
resolved at an early stage: 


e Function Distribution. To what extent should we try to do things in the var- 
ious subsystems rather than in the central CICS? 


e User Interface. Should we attempt to define a standard one for all subsys- 
tems, or allow each to select its own? | 
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e Available Tools. What standard system components and specialised program 
products could be utilised to avoid developing new code? 


1.2.1 DISTRIBUTION OF FUNCTION 


The subsystems under consideration vary widely in the programming facilities 
they offer: a VM system, for example, is vastly more powerful and flexible than 
a 5280, and a function that is straightforward to implement on one may be 
unreasonably difficult on the other. Furthermore, the range of programming 
skills needed to support several subsystem types may be very wide. 


It therefore seemed sensible to minimise the amount of function performed in the 
subsystem, in order to minimise the amount of duplicated work in a network con- 
taining a variety of subsystem types. This is the most generalised approach, 
and is reflected in our design, but in a network containing only one subsystem 
type, it might well be worth reconsidering this decision. 


1.2.2 END-USER INTERFACE 


Each subsystem has its own interfaces to its end-users, and it would usually be 
desirable to retain some consistency with these; to achieve this, however, an 
installation with a variety of different subsystems may have to write the same — 
function several times; on the other hand, each group of users could have an 
end-user interface that is consistent with the rest of the system. 


Our conclusion was that the need to minimise duplicated effort would usually 
override the wish to provide tailored user interfaces, although, again, this bal- 
ance might well change in a network containing-a large number of one subsystem 


type. 


1.2.3 AVAILABLE TOOLS 


Two functions are common to all of the subsystems: 


3270 Emulation The ability to appear to a host system as a cluster of remote- 
ly-attached 3270 displays. This may be a BSC or an SNA 
attachment, depending on the subsystem concerned, but both 
are supported by NCP and VTAM and can thus access any 
host application that supports 3270s. 


Remote Job Entry The ability to emulate a batch terminal in order to send bulk 
data to the MVS host. The subsystems use a variety of proto- 
cols: 


e BSC 2780 or 3780. 

e¢ BSC Multileaving Remote Job Entry (MRJE). 

* SNA Single Logical Unit (SLU). 

e SNA Multiple Logical Unit (MLU). 

The first and third of these protocols are supported by 
CICS; all four are supported by JES. 
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Other communications facilities exist in some of the subsystems. For example: 


e User programs in most subsystems may use SNA functions to communicate 
with a CICS application; however, the programming interfaces differ great- 
ly, and the same programs could not be used in all subsystems. 


¢ Some 3270 Emulation packages allow batch data to be read from disk and 
transmitted as if it had been keyed. This capability exists only on certain 
configurations of Displaywriter and PC, and there is no standard host soft- 
ware to perform the complementary receiving function for all implementa- 
tions. 


Since no communications function other than 3270 Emulation and RJE is common 
to all of the subsystems, our objective of generality requires that we base our 
system on them. | , 


Given that all the subsystems can emulate 3270s, it is likely that DISOSS/PS will 
be a valuable tool, since its purpose is precisely t to allow 3270 devices to make 
use of the DISOSS functions. 


1.2.4 DISOSS/PS FOR INTERACTIVE FUNCTIONS 


DISOSS/PS is a CICS application; it supports 3270 terminals, and provides 
end-user services for users of those terminals. Thus it can be regarded as an 
intelligent subsystem using DISOSS services, just as the DISOSS/8100, 5520 and 
Displaywriter subsystems do; the only difference is that DISOSS/PS executes 
under CICS, rather than in a separate machine, and communicates with DISOSS 
via the API rather than via an SNA session. 


The components involved in connecting Box X to DISOSS via DISOSS/PS are 
shown in Figure 1 on page /. 


DISOSS/PS provides the 3270 user with access to most of the functions of 
DISOSS, including: 


Distribution A mailbox for documents’ received from  Displaywriter, 
DISOSS/8100, 5520 and other DISOSS/PS users. The following 
ee can be performed on a document in the DISOSS/PS 
mail-log: 


e View 

° File in the DISOSS Library 

e Redistribute to other DISOSS users 

e Print at the MVS host | 

e Delete 

In addition, DISOSS/PS provides a limited text entry and editing 
function, so that simple documents can be created at the screen 
and filed in the library or distributed to other DISOSS users. 


Library The DISOSS/PS user has access to the DISOSS document library 
and can use the following functions: | 
e Search 
e View 
° Distribute 
° Print 
° Delete 
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Figure 1. Interactive Communication between Box X and DISOSS 


Clearly, then, DISOSS/PS provides many of the required functions to any sub- 
system that can emulate a 3270. However, precisely because it is designed for 
32/0 users, there are two important functions that it does not provide: 


e A means of retrieving a document from the DISOSS/PS mail-log or the 
DISOSS library to the subsystem's own storage. 


¢ A means of filing or distributing via DISOSS a document or file created and 
stored at the subsystem. 
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We need a.means of moving documents in both directions between DISOSS and 
the subsystem; this is essentially batch data transfer, and our. chosen vehicle 
for this is one of the RJE protocols. 


1.2.5 RJE FOR BATCH FUNCTIONS 


All of the subsystems can emulate a batch terminal of some kind, and CICS sup- 
ports certain batch devices, so clearly it would be convenient to connect the 
subsystem to CICS and use a CICS transaction to send and receive files or doc- 
uments. However, there are several difficulties: 


° CICS does not support all of the protocols used by the various subsystems. 
In particular, it does not support the BSC MRJE and SNA MLU protocols. 


e Using a BSC protocol to communicate with CICS would usually require a ded- 
icated connection between Box X and CICS. This may imply a dedicated line 
plus two modems, which may be too expensive if the number of document 
transfers is low.? The SNA SLU protocol would avoid this problem, but is 
not supported by all subsystems. 


e Not all subsystems can support multiple physical connections to a host, and 
if one is already installed, it is more likely to be communicating with an RJE 
system than with CICS. 


¢ Subsystems designed in the expectation of communicating with an RJE sys- | 
tem may be more difficult to operate when communicating with a user-written 
CICS transaction. | 


e JES has good facilities for recovering from communications failures, 
safe-storing and re-transmitting data. Equivalent function, if desired in a 
CICS connection, would have to be programmed by the user. 


e JES is normally available whenever the operating system is running; thus a 
job can be submitted whenever the network is available, regardless of 
whether CICS is executing or not. 


For these reasons, we concluded that the most general approach would be to 
have the subsystem communicate with the RJE system rather than directly with 
CICS. This leads to the question of how documents are to be moved in both 
directions between JES and CICS. 


2 ‘It may be possible to reduce this cost in some cases: 


e Channelised modems would allow two or more ‘separate’ connections to 
use the same physical link. This would still require separate 3/x5 ports 
for each connection, and depends on the total traffic being low enough 
to allow the bandwidth to be divided up in this static way. 


e Use of the Non-SNA Interconnection (NSI) licensed program in the 37x5 
would allow the subsystem to switch its connection from one host appli- 
cation to another, for example between JES and CICS. This, of course, 
implies that only one communication function could use the physical link 
at a time, which may be operationally unsatisfactory. 
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1.2.6 MOVING DOCUMENTS FROM CICS TO JES- 


We could write a CICS transaction to obtain documents via the DISOSS API, 
transform them into a datastream appropriate to Box X, then submit batch jobs 
(via the operating system's internal reader facility) to place the transformed 
documents on the JES spool. 


As it happens, however, there is a standard function in DISOSS which will 
achieve the same result. The Host Print facility submits a batch job whose 
function is to transform a document from its DISOSS form into a series of print- 
lines appropriate to a host-attached 1403 printer. This print data is output to 
the JES spool, from where it can be printed on a real printer, or routed to some 
other destination known to JES. This destination could of course be our remote 
subsystem. 


Thus, the DISOSS Host Print function, together with appropriate JCL state- 
ments to direct its output, provides the means of moving a document from 
DISOSS to Box X, without the need for any user programming. Figure 2 on 
page 10 shows the connection involved. 


1.2.7 MOVING DOCUMENTS FROM JES TO CICS 


There is no standard DISOSS function to meet this need, so this is a more diffi- 
cult problem; nevertheless, there are several possible solutions: 


Direct SNA Session between JES and CICS, or between the submitted batch 
job and CICS. 


SNA Relay Program receiving data from JES on one side, and passing it on to 
CICS on the other. 


JES External Writer executing under CICS and reading data from the JES 
spool. 


Shared Dataset allowing the batch job to insert data, and CICS to 
retrieve it. 


1.2.7.1 Direct SNA Session 


The Network Job Entry (NJE) functions of JES2 and VSE/POWER (but not JES3 
or OS/VS1 RES) allow one JES system to pass jobs and output across an SNA 
session to another JES system. If such a session could exist between JES and 
CICS, then JCL statements in the job submitted by Box X could cause the job to 
be passed on to CICS rather than executed by JES. Unfortunately, however, 
such a session is not possible since CICS does not support the particular set of 
SNA protocols required by JES for this purpose. 


Alternatively, the job submitted by Box X and executed by JES could certainly 
establish an SNA session with CICS and pass the document across this session 
to a user-written CICS transaction. The main problem is one of recoverability. 
If the program cannot establish its session with CICS for some reason, it cannot 
continue; but if it terminates, its input data is lost, and the originating user 
must resubmit his request. It would be preferable to ensure that the data 
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Figure 2. Document Transfer from DISOSS to Box X: this assumes an SNA 
connection. If the RJE connection were BSC, RTAM would be used 
instead of VTAM. 


remains safely on the JES spool until we know it can be delivered to CICS, and 
this cannot easily be achieved with this approach. 


| Ey a ge | SNA Relay Program 


This program would be a long-running task, active in the system whenever JES 
and CICS are running. It would establish two SNA sessions: 
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1. With CICS. This might be one of several session types supported by CICS; 
the most convenient would probably be either the SNA SLU batch session, 
or the LU6.2 session which is specifically designed for program-to-program 
communication. 


2. With JES. Only when the session with CICS is active would this second ses- 
sion. be started, thus avoiding the recoverability problem noted earlier. 
This session might use the SNA SLU protocol to appear to JES as a 3//0 RJE 
device. Alternatively, it might use the SNA Network Job Entry protocol, so 
that it would appear to JES as another JES. In this case, the batch job 
submitted by Box X would not be executed by JES, but would be passed to 
the relay program, which would in turn pass it on to CICS. 


This approach avoids the problems of both types of direct session discussed 
above: no batch jobs need be executed by JES, yet the JES spool is used as a 
safe store until the data can be delivered to CICS. 


The disadvantage is that the VTAM programming skills needed to implement it 
are not universally available, and for that reason it must be rejected in our 
case. 


1.2.7.3 JES External Writer 


An external writer is a user-written program using interfaces provided by the 
operating system to read output data directly from the JES spool. If such a pro- 
gram were executing as a CICS application, it could read JES output into the 
CiCS system with no need for SNA sessions. Unfortunately, the interfaces pro- 
vided by MVS and VSE are not suitable for use under CICS, since they issue 
WAIT macros which would cause the entire CICS system to wait; the alternative 
is to implement the External Writer via a user SVC, but again we felt that this 
type of programming skill would not be widely available. 


A further disadvantage is that this interface can only handle SYSOUT data: in 
other words, the incoming data is always 1403 printlines. This will often be sat- 
isfactory, but cannot handle the possibility that Box X may wish to send some 
more sophisticated datastream. 


Introduction and Design Overview 11 


1.2.7.4 Shared Dataset 


An apparently very simple approach to the problem is to allow the job submitted 
by Box X to write its document into a disk dataset, from where it can subse- 
quently be read by a CICS transaction. There are still some poten! difficul- 
ties, however: | | 


¢ The dataset mee be eaneumeauly shared between CICS and ais Baek job, 

since it would not be satisfactory to run the batch jobs only when CICS was 
down. JCL can allow both CICS and the batch job to allocate the dataset, 
but to avoid data integrity problems we must ensure that concurrent updat- 
ing is not allowed, or is very carefully controlled. VSAM can simply over- 
come this problem, by ensuring that only one task can open the dataset at a. 
time; alternatively, concurrent updating can be Peithees with VSAM, at 
the cost of increased user programming effort. 


e If the dataset is to be used concurrently by batch and CICS over a long 
period, then we must be able to insert and delete records; this in addition 
to the need for frequent OPEN and CLOSE functions from both batch and 
CICS, could create a significant performance bottleneck if not considered 
carefully in the system design. 


However, this approach has the major advantages of being easy to program and 
maintain, since VSAM file operations are well understood in most installations. 
Also, having examined the potential performance problems, we felt that careful 
dataset and application design could contain them to acceptable levels. We there- 
fore concluded that, given our original objectives, this technique would be most 
appropriate. Figure 3 on page 13 summarises the connection for document 
transfer from Box X to DISOSS. 


1.2.8 CICS APPLICATION TO ACCESS DISOSS API 


By using the DISOSS Host Print function plus NJE for document transfer from 
DISOSS to Box X, we eliminate the need for user-written CICS programs to 
obtain documents via the API and redistribute them to Box X users; thus new 
code is only needed to pass documents into DISOSS from Box X. The next ques- 
tion is, how much DIA function needs to be supported in this new user code? . 
Any DIA application must support the SIGN_ON, ACKNOWLEDGE and SIGN_OFF 
commands, and in this case we will also need either FILE or 
REQUEST_DISTRIBUTION (or both) in order to pass documents into DISOSS: 


e FILE requests that DISOSS file the attached document in its library. This 
command has many operands, since users may want to specify many attri- 
butes of a document in order to ensure that it can later be retrieved in a 
satisfactory way. Any of the following may be specified, for example: 


—- Document Name 

— Author 

—- Subject Matter 

— Recipients 

— Keywords for later search operations 

—- Document Class (e.g. Memo, Letter, Report etc.) 

—- Access Codes to ensure the desired level of security 

Consequently, of course, ‘File’ is potentially a complex command, and there- 
fore a variety of end-user errors could occur and would need to be handled 
by our code. For example, if the end-user specified an invalid Access Code, 
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Figure 3. Document Transfer from Box X to DISOSS: the batch user program | 
communicates with the CICS user program via a shared VSAM dataset 
not shown in this diagram. 


DISOSS could not perform the File operation and would inform us via the 
API. We would either have to discard the document and notify the end-user, 
or ask the end-user to correct his request so that we could retry the File 
command. oe 


REQUEST_DISTRIBUTION asks that DISOSS distribute the attached docu- 
ment to a named user or users. Since the document is not permanently 
stored in the library, there is usually no need for all the descriptive infor- 
eee required by the File command. Often, only the following would be 
needed: | | 
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—- Document Name 

— Recipients. | : | 
Mawever it would probably be desirable for the ene user to have, in addi- 
tion, at least the following: e 


- Distribution Lists, so that he could simply name a list in order to nave a 
document distributed to several users. 

—- Priority Distribution, so that he could designate one decunent as more 
urgent than another. | 

— Personal Distribution, so that he could designate a document as Per- 
sonal to the recipient G. e. not available to the recipient's secretary). 

These functions, of course, would also add complexity both to the Box x 

end-user interface, and to the user-written CICS programs. 


A reasonable interface should allow the Box X user to use both the filing and 
distribution services of DISOSS, but a serious difficulty arises: there is no 
interactive communication between the Box X user and the CICS application, 
since document transfer occurs via batch RJE facilities, and thus there is no 
reasonable way to converse with the end-user when DISOSS or our code detects 
an error in his request. All we can do is send him a report identifying the error 
and asking him to resubmit his request at some time in the future. Obviously 
this is not ideal, but the more function we offer the end-user, the greater the 
risk of such errors occurring. 


Thus we have conflicting requirements: 


° Full support of the File and Request_Distribution functions in the user API 
programs will: 


— Add complexity to the end-user interface at Box X, to allow the user to 
specify the various options. 

- Add complexity to the user API programs to handle these options, build 
the more complex DIA commands, interpret the possible error notifica- 
tions returned by DISOSS, and return some useful message to the 
end-user. 

—- Still only offer a batch-type interaction with the end-user, which he is 
unlikely to find attractive. 


This conflicts with our objectives in two ways: 


1. It will require significant user code in each subsystem type to support 
the more complex end-user interface. 

2. It adds considerable complexity to the CICS application, and therefore 
threatens the ease of implementation objective. 


e On the other hand, the requirement that our system be generally applicable 
across a wide range of subsystems and user groups, demands that the full 
range of the DISOSS Library and Distribution services be made available. 


The solution to this problem was surprisingly simple: 


1. The Box X user is already a user of DISOSS/PS, and DISOSS/PS already 
provides extensive support for the full range of filing and distribution 
functions. Furthermore, it does so interactively, giving the end- user a 

~ chance to correct an invalid request and resubmit it at once. 


2. Our CICS application can distribute the Box X document to the DISOSS/PS 
userid representing the Box X end-user. Thus the Box X user will see the 
document in his mail-log, and can use all the facilities of DISOSS/PS to file 
or distribute it. 
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The user-written CICS code is thus greatly simplified, since it only has to 
support a simple form of the Request_Distribution command?, with a much 
reduced likelihood of errors. Furthermore, the subsystem-unique code is 
also simplified, since the complexities of the end-user interface for full sup- 
port of filing and distribution are now handled by DISOSS/PS. 


This approach views the user-written code as just a means of delivering Box X 
documents to DISOSS/PS, which is the principal means for the Box X user to 
interface with DISOSS. Apart from minimising the complexity (and thus the 
maintenance) of the user-written code, it also increases the likelihood that the 
Box X user will be able to take advantage of any new function in DISOSS or 
DISOSS/PS, without being dependent on corresponding enhancements in the 
user-written CICS programs. 


3 


In fact it may also be desirable to support a simple form of the File com- 
mand. This is because a document delivered to DISOSS/PS is transformed on 
receipt into a simple DISOSS/PS internal datastream; it is not always possi- 
ble to reconstruct the original datastream when the document is subsequent- 
ly filed or redistributed from the DISOSS/PS mail-log. In such cases, our 
system can perform a simple File operation on behalf of the DISOSS/PS 
user, who thus becomes the owner of the document in the DISOSS library, 
oS. can therefore update the profile or redistribute the document as he 
wishes. : 
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1.3 OVERVIEW OF THE SYSTEM STRUCTURE 


Figure 4 on page 1/ illustrates the general organisation of our system design, 
intended to allow the Box X user to work interactively with DISOSS via 
DISOSS/PS, and to transfer documents in both directions between DISOSS and 


Box &. 
To summarise the main characteristics: 


1. DISOSS/PS is the principal end-user interface to DISOSS, and is used for 
all interactive functions. 


2. DISOSS/PS invokes the DISOSS Host Print function in order to move a doc- 
ument to Box X from either the DISOSS library or the DISOSS/PS mail-log. 


3. RJE and user-written batch and CICS programs are used to move a docu- 


ment from Box X to the Box X user's DISOSS/PS mail-log, from where the 
full functions of DISOSS/PS are used to file or distribute it. 
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Figure 4. DISOSS--Box X Interactive and Document Transfer Connections 
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2.0 SYSTEM STRUCTURE 


This chapter describes the general structure of the suggested design, and 
summarises the functions of the various components. 


"Introduction and Design Overview" on page 3 has shown that our system has 
three logical components: 


e Interactive communication between the Box X end-user and DISOSS/PS. 
e Document transfer from DISOSS to Box X. 
e Document transfer from Box X to DISOSS. 


2.1 INTERACTIVE COMMUNICATION 


This. is implemented by a combination of existing product functions, and all that 
is required to deliver the needed end-user function is appropriate customising 
of the following: 


° Box X 3270 emulation component. 

° NCP, VTAM and CICS definitions for the emulated 3270 terminals. 
¢ DISOSS/PS definitions for the Box X end-users. 

° DISOSS Host User Profile definitions for the DISOSS/PS users. 


The general organisation is shown in Figure 1 on page 7, and this component of 
the system is not further described in this chapter. 


2.2 DOCUMENT TRANSFER FROM DISOSS TO BOX X 


This too is implemented by a combination of existing product functions, and all 
that is needed is appropriate customising of the following: 


Box X RJE component. 

Definitions for the Box X RJE component in JES and in EP or NCP/VTAM. 
JCL procedures to route output to Box X. 

DISOSS Printer Description Table definitions to generate the appropriate 
Host Print batch jobs. 


The general organisation is shown in Figure 2 on page 10, and this component 
of the system is not further described in this chapter. 


2.3 DOCUMENT TRANSFER FROM BOX X TO DISOSS 


This component of our system is the only one requiring user-written code, and 
will be the subject of the remainder of this chapter. Figure 5 on page 20 shows 
the major components involved. 
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2.3.1 MAJOR COMPONENTS 


2.3.1.1 Box X Job Submission 


User programming in Box X performs the following functions: 


Constructs a document header record to identify the document, its format 
and its destination, so that the appropriate DIA request can be constructed 
at the host. 


Breaks the text lines into 80-byte card images. 


Adds JCL to invoke the appropriate user-written batch program, and sub- 
mits the job via the RJE system. 


2.3.1.2 Batch Program 


DBTBAT1 is a user-written batch program whose purpose is to insert the Box X 
document in the shared VSAM dataset DBTVSQO. In order to minimise contention 
for the dataset, and to minimise the number of insert and delete operations 
needed to transfer the document, DBTBAT1 does the following: 


e 


Builds a document header from the header card sent by Box X. 
Reads the card images sent by Box X and rebuilds the original text lines. 


Concatenates these lines of text, separated by X'1E’ Interchange Record 
Separator characters, in large physical records. 


Adds a unique document identifier to be used later as part of the VSAM 
key, then writes the large records to a temporary dataset. 


When the document is complete, opens the the shared VSAM dataset and 
inserts the contents of the temporary dataset. 


2.3.1.3 CICS Program DBTSON1 


This program starts a DIA session with DISOSS via the API, and would normally 
be executed at CICS start-up time. Having established the DIA session, it could 
then initiate transaction DBTM to start document transfer. 
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2.3.1.4 CICS Transaction DBTM 


This transaction consists of one program, DBTMOV1, whose purpose is to move 
Box X documents from the shared dataset DBTVSQO to an identical VSAM data- 
set, DBTVSQ1, which is wholly controlled by CICS. Functions are: 


Call subroutine DBTOPN1 to open the shared dataset. 


If the open is unsuccessful, schedule a new DBTM for a later time, and 
end. 


If the open is successful, copy all DBTVSQO data into DBTVSQ1. 

For each complete document transferred, initiate transaction DBTS, passing 
it the key of the document in DBTVSQ1, and delete the document from 
DBTVSQO. 

Call subroutine DBTCLS1 to close the shared dataset. 


Before ending, schedule a new DBTM transaction to execute a few minutes 
later. 


2.3.1.5 CICS Transaction DBTS 


This transaction contains the main processing of the system, and consists of 
several programs: 


Program DBTMST1 examines the document header in DBTVSQ1, identifies an 
appropriate program to transform the input datastream to the desired output 
datastream, and invokes that transform routine. 


The chosen transform program, DBTTRNn, converts the text of the 
DBTVSQ1 distribute request to a datastream understood in the DISOSS sys- 
tem (probably the DCA Level 2 Final Form Text datastream), and passes 
control to program DBTSND1. 


DBTSND1 builds the appropriate DIA structure, called a Document Inter- 
change Unit (DIU), which contains a DIA Request_Distribution command and 
the document text, and passes it across the API to DISOSS, requesting that 
transaction DBTR be invoked to process the subsequent response from 
DISOSS. 


2.3.1.6 CICS Transaction DBTR 


This transaction consists of one program, DBTRSP1, which checks that the dis- 
tribution request was successful, and deletes the document from DBTVSQI1. 
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SAMPLE IMPLEMENTATION 


SAMPLE IMPLEMENTATION ZO 
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3.0 SAMPLE SYSTEM IMPLEMENTATION 


This chapter describes the sample implementation that was made to validate the 
system design. We used VM/CMS as our Box X, and therefore this sample has 
only implemented support for one inbound datastream, the 1403 printline. 


It is important to remember that the purpose of this implementation was solely to 
show that the proposed design was workable. It was never our intention to pro- 
duce an implementation that could be used in a production environment: that 
would have required more detailed documentation, more extensive error 
detection and recovery code, and more rigorous programming and testing tech- 
niques than were possible in the timescale of our project. 


This sample implementation is only intended as a demonstration, and is not 
appropriate for any other use. 
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3.1 MOVING. DOCUMENTS FROM DISOSS TO BOX X_ 


The design of a CICS-Batch interface can be straightforward, because CICS 
applications can write jobs to the internal reader. The DISOSS Host Print facili- 
ty uses this technique, so rather than duplicate many of the functions of 
i eet ae the Host Print facility | was used as the basis for the DISOSS to Box X 
interface. 


The DISOSS Host Print facility works as follows: 


¢ The DISOSS user enters the name of a logical printer in the Destination 
Name field of a Host Print menu. 


¢ A batch job is written to the internal reader for execution. The oe: job 
contains the following: | 


— A jobname derived from the Host Print Menu jobname field. 
— Jobcard parameters derived from: 


— The accounting information in the Host User Profile of the DISOSS 
user. 


— The JOBJCL option that was specified in the Host Definition job 
during installation | 


- An invocation of the format procedure whose name was specified in the 
JOB option of the PDT entry for the logical printer entered in the des- 
tination name field of the Host Print menu. 


— An input dataset with the document text inline. 


e A format program, usually the DISOSS supplied. DSVOL500, should do the 
following: 


- The document is formatted into 1403 printlines, according to the format 
options and the printer characteristics data specified in the relevant 
entry in the Printer Description Table (PDT). | 


— The print/fidelity table index DSVS5800 is searched for a table with an 
input GPID and output GCID corresponding to the document GPID and 
the printer GCID specified in the PDT entry. The output characters 
are translated if a table is found. 


¢ The output document is routed by JES to the printer determined by the 
procedure JCL. 
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3.2 MOVING DOCUMENTS FROM BOX X TO DISOSS 
3.2.1 USE OF THE DISOSS API 


3.2.1.1 General Remarks 


One of our design objectives was to avoid the need for specialised programming 
skills wherever possible; thus we have: rejected designs requiring the use of 
VTAM programming or the JES External Writer interfaces, and the DISOSS API 
itself is the only requirement for special programming Knowledge. We do not 
attempt to describe the API in this book, and recommend that the following doc- 
uments be regarded as essential reading for anyone wishing to understand this 
implementation in detail: 


$C30-3096 DISOSS/370 Version 3 Application Programming 
GG24-1614 DISOSS Application Interface: Programming Guidelines 


However, for the general reader, the following points may be helpful. 


¢ The API consists of a queue (implemented as a VSAM KSDS), and a set of 
commands to insert and retrieve data on that queue. The data itself must be 
in the form of a DlA-defined DIU. 


e A DISOSS supplied module (DSVAWO00) must be part of the user transaction 
to invoke the API commands. 


e Every transaction that wants to use the API has to issue an API ‘Activate’ 
command first, and provide a DISOSS user name for the session. Then, the 
first command on the DIA session must be an API-BIND, which will build a 
DIA Sign_On. 


e Multiple DIUs can be put on this queue by different CICS transactions for 
the same DIA session. On an ‘Activate’ command, the API takes a unique 
time stamp for that transaction and username of the DIA session. This time 
stamp will be used as a key field for all data of this transaction put on the 
APli-queue. 


e DIUs will only be processed after receipt of a API ‘Last’ command, and a 
syncpoint of the user transaction. 


e Only one DIU will be processed for every ‘Last’ command. 

e Updates on the API queue will be backed out if an abend occurs. 

e The responses for DIA commands that are processed through the API must 
be analysed by a new transaction named in the API ‘Last’ command. That is, 


the API is an asynchronous interface. 


¢« The API gives the 16 byte DIU-ID field as part of the receive data for the 
response. (DIU-ID is provided by the originator of a DIU). 
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3.2.1.2 Our Use of the API. 


The Box X to DISOSS transactions distribute documents into DISOSS by means 
of a 2-way multithread communication with the DISOSS API; that is, multiple 
DBTS transactions may concurrently pass documents into the API, and multiple 
DBTR transactions may concurrently receive results, but all share the same DA 
session with DISOSS. and are regarded by Poe: as one user. 


Sign_On and Sign_Off are provided by separate CICS transactions.  PPaasaction 
DBTN may be used to perform Sign_On if the CICS start-up procedure does not 
invoke program DBTSONI] to do so. DBTF perenne a DIA rene Off, though this 
is not normally required. 


Transaction DBTS sends a distribute request to lve API. For each document it 
builds one DIU of the structure shown in Figure 5. | 


—_______—— DOCUMENT INTERCHANGE UNIT (OU a 
DI U Req_Distr. DOCUMENT DOCUMENT |DOCUMENT |DOCUMENT /DIU 
_ |PREFIX |COMMAND —|UNIT segl UNIT sege UNIT aul UNIT seq! SUFFIX | | 


Figure Dig: DIU ‘Structure Built by DBTSND1: ‘the maximum number of document 
units in one DIU is 255 (DIA architecture limitation). There is 
no limit on me number of Sean: in a document unit. 


The structure of document unit segments that contain L2DCA data is shown in 
Figure 6. As there is no limitation on the number of segments in one document 
unit, there is also no limit on the size of a document to be passed through the 
API (except, of course, the size of the APIl-queue dataset). a 


__ pocuMENT INTERCHANGE UNIT. (o1y) ————_____ 


Req_Distr. DOCUMENT DOCUMENT DOCUMENT |DOCUMENT | DIU | 
PREFIX COMMAND UNIT sll UNIT — UNIT segn|UNIT = SUFFIX 


DOC. UNIT DCA-LEVEL_2 eee DATA 
introducer 


x'C90381200000' 


Figure 6. Document Unit Segments for Document Text: these are 
middle-in-chain segments, with only L2DCA data. 
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The document unit is ended by a segment with only a ‘last segment indicator’ 
and no data, shown in Figure 7 


Req_Distr. {DOCUMENT |DOCUMENT |DOCUMENT |DOCUMENT | DIU 
PREFIX COMMAND UNIT segl|UNIT seg2|UNIT segn|UNIT seg] | SUFFIX 


———————— DOCUMENT INTERCHANGE UNIT (DIU) —————————-_—____- 


DOC. UNIT introducer 
X'C90381000000'! 


Figure 7. Last Document Unit Segment: there is no text content, only a 


last segment indicator. 


These DIA structures are built by the DBTSND1 program, which calls a set of 
subroutines to perform particular functions: 


APIACTIV issues the API 'ACTIVATE' command for user DISTO1, which is 
te ~ user solely defined for this interface in the DISOSS Host User Pro- 
ile dataset. 


APIGTCMD issues API ‘RECEIVE’ to receive data from the API queue. it 
parses the data and sets return code fields for the caller. 


APIDIS2 (or APIFIL2) builds the first DIU part, up to and including the 
first document unit containing the document base profile, and issues API 
‘SEND’ to pass it to the API. 

APIPTDOC sends the remainder of document unit segments through the API. 
APISUFIX passes the DIU suffix through the API. | 
APILAST issues API ‘LAST’ command. 


APIPURGE issues API 'PURGE' command in case of errors. 


Refer to DISOSS Application Interface: Programming Guidelines, GG24-1614 for 
details of the design and operation of these subroutines. 
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DIU Correlation Data © 


DOCUMENT INTERCHANGE UNIT (DIU) ——————___ 


|Regq_ Distr. DOCUMENT DOCUMENT |DOCUMENT |DOCUMENT |DIU 
PREFIX COMMAND UNIT segl|UNIT seg2|UNIT segn|UNIT seg] | SUFFIX 
PFX Xx! COOLxx' 
DIUID X'. 


Figure 8. DIU Prefix: the DIU-id field can be expanded to 16 bytes, and is 
ee saeco system to correlate responses in DBTR with requests 
rom. 


The first 16 bytes of the DBTVSQ1 record key are used as the correlation data 
in the DIU prefix. This data is unique, being made up of the date and time of 
creation, together with an identifier of the creating interface (which in this case 
is always the DBTBAT1 program). It is used as the document identifier in the 
API communication, and it is passed to the response transaction DBTR. It can 
be used by DBTR to identify the processed Box X request on DBTVSQI1, so that 
appropriate action can be taken. In the current design, this action is to delete 
the request from DBTVSQ1 if it was successful, and to issue an API PURGE if it 
was unsuccessful. 


Request_Distribution Command 


——————- DOCUMENT INTERCHANGE UNIT (DIU) ————_—————————_ 


DIU Req_Distr. |DOCUMENT |DOCUMENT |DOCUMENT |DOCUMENT | DIU 
/PREFIX | COMMAND UNIT segl|UNIT seg2|UNIT segn|UNIT seg] | SUFFIX | 
COMMAND | IDDATA-1|DEST NODE|ATTRIB. | RECIPIENT 
X'CC1C01' ADDRESS |LIST ADDRESS 


Figure 9. Request Distribution Command: attribute list and recipient 
address are required parameters. 


The command itself is in the ARR eeuncieonsis reply required) command class 
designated by X'CC' in the ‘I’ byte of the command. ARR commands will be 
replied to with an ACKNOWLEDGE command together with correlation data. It 
contains the following parameters: 
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e Identified Data format 1, for pointing to the first document unit in this DIU 
as the document for this command 


e Destination node address format 1, an 8 byte parameter designating the 
office systems node for the recipient address. 


e Attribute list format 1, a required parameter, specifying: 
—- no confirmation of delivery, 
— not personal, 
—- no priority, 
— number of copies = 1. 


DIA gives the option to specify a 256 byte message in this parameter, but 
this is not used by our programs. 


e Recipient address format 1, a required parameter up to 8 bytes long. 


The address combination would usually be a DISOSS/PS user because 
DISOSS/PS provides all necessary functions for documents in the mail-log; how- 
ever, a simple distribution to one user can still be done directly. 


Document Profile 


—————— DOCUMENT INTERCHANGE UNIT (DIU) ——————______ 


Req_Distr. |DOCUMENT |DOCUMENT | DOCUMENT | DOCUMENT DIU 
PREFS COMMAND UNIT segl|/UNIT seg2|UNIT segn|UNIT segl | SUFFIX 
V 
DOC. UNIT|DOC. PROF.|DOC. PROF. |DOC.j|PROF.|DOC. | SUB—| AUTHOR 
introduc. | INTERCH. BASE TYPE}GCID | NAME) JECT 
///\ DOC. CONTENT | 
///\ introducer 


/// 
/// 


V DOC. UNIT ID 
X'C90381200000' | DOC. | SYST. 
TYPE | CODE 


Figure 10. Document Profile Information: the first document unit segment 
contains the document profile only. The first document unit 
introducer in a segmented chain has a document unit id. 
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The first document unit contains the document profile. We provide the following 
parameters: 


Document name, a required parameter, maximum length of 15 characters in 
our design (44 characters DIA maximum). According to DIA rules the first 
and last character of the name may not be a space. 


Document type, a required parameter, a 2 byte field in our case always 
X'0002' for L2DCA data. | 


Profile GCID, a required parameter, in our case always set to X'01510100'. 
This is the standard GCID in DISOSS for profile data. 


Document GCID is omitted from the document profile. The document GCID is 
set in the DCA level 2 datastream to X'00D7/70108'. This is the standard GCID 
in DISOSS for the 1403 TN chain. DISOSS will look in the DCA datastream 
for the document GCID. See "Datastream Transformations” for a discussion 
of why this GCID was chosen. 


t 


Subject, always set to ‘Mailbox Project 


' 


Author, always set to ‘Mailbox 


3.2.2 DOCUMENT TRANSFORMATIONS AND TRANSLATIONS 


3.2.2.1 Datastream Transformations 


From Box X inward the following data transformations are performed on 1403 
print lines; a header record identifies the incoming data as 1403 rather than any 
other datastream. 


1. 


34 


In Box X: reformatting of print lines to 80 byte cards for transportation 
through the RJE system as SYSIN data. 


Certain boxes might have abilities to transport data in a more efficient way 
through a network. However the design of these programs woul? then no 
longer be general. 


In the DBTBAT1 program: re-blocking of 80 byte SYSIN data to print-lines 
and blocking of print-lines in records with a maximum size of 5959 bytes (+ 
key of 39 bytes + 2 bytes length field = 6000 bytes). All trailing blanks in 
the print lines are deleted. Blocking and deletion of trailing blanks is done 
solely for efficiency purposes. For unblocking purposes the following addi- 
tional data transformations are done: | 


° Print lines are separated by IRS codes, X'1E'. 


¢ Except for the first byte, which should be the 1403 print control char- 
acter, all characters below X'40' are converted to X'40', to ensure that 
no extraneous X'1E'’ characters will be present in the print data. (With 
DCF, any character could have been generated as print data). 


This serves an additional purpose: In L2DCA, multibyte and one-byte 


controls are used to control the final printing of data; ail multibyte con- 
trols start with X'2B', so the above transformation ensures that no 
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unwanted multibyte controls are present in the 1403 datastream. Single 
byte controls above X'40' in DCA Level 2 that could still occur in the 
datastream are: 


— Numeric Space, X'E1' 
— Required hyphen, X’'60' 
—- Required Space, X‘41' 

— Syllable hyphen, X'CA' 


3. In the DBTTRN1 program, the actual transformation of 1403 print data to 
DCA Level 2 is done. The DCA Level 2 controls used should provide docu- 
ment integrity for 1403 print data. After finding the print lines in the 
blocked record the IRS codes are removed. 1403 print controls are con- 
verted as follows: 


Space 1 line after printing 09'-prtline X'OD'-prtline-X'15! 
Space 2 lines after printing 11'-prtline X'OD'-prtline-X'1515' 
eae 3 pee sue ea 19'-prtline x! elec xX! eae 
ip to channel 1 after prt 89'-prtline X'OD'-prtline-x' 
Skip to channel 2 after prt 91'-prtline 4 ae Jes a a 1515! 
so aha eae -prtline-X'1515 
channel 12 after prt El'-prtline X'OD'-prtline-X'1515' 
line immediate 0B’ -prtline x! iS! -prtline 
lines immediate 13 -prtline X'1515 “prtline 
ec ae ser Anas a Acta pecans 
chanel { lenediete BB'ortline | X'0C'-prtl ine 
channel 2 immediate 93'-prtline ae a 
See irik so oecias De -prtline 
channel 12 immediate E3'-prtline X'1515'-prtline 
Write without spacing O01'-prtline X'OD'-prtline 
No-op 03'-prtline delete prtline 
Anything else -prtline X'15'-prtline 


ANSI Print Controls 2 ee 


Space 1 line before printing X'40'-prtline X'15'-prtline 
Space 2 lines before printing -prtline X'1515'-prtline 
Space 3 lines before printing - -prtline | X'151515'-prtline 
No space before printing + -prtline X'OD'-prtline 

| Start new page 1 -prtline X'OC'-prtline 


The X'0D' controls at the beginning of 1403 print controls that are effective 
after printing ensure that if a previous print line had an ‘immediate’ print 
control, these print lines still will start printing in position 1 of the print 
line. 


At the end of the document, the last print line will have no NL (X'15') 
appended to it, since this could overflow the presentation space. Instead 
the document will end with ZICR (X'0D') and FF (X'0C'). The reason for 
this is that Displaywriter and DOSF do not always start a new document 
with a form feed as SCRIPT output normally does; they end a document with 
ZICR and FF instead. Documents without ZICR and FF at the end will give 
an error message on Displaywriter when printed. 
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Additionally, some initial settings for formatting are necessary with multi- 
byte controls. The following settings are Paes by DBTTRNI: 


e SEA, set exception action, X'2BD2nn85' where nn is a count field. We 
have set the exception class and action bytes to X'0000' which means: 
for all exception classes - still present the data but indicate loss of 
fidelity and possible alternatives. If print fidelity is required this 
should be set to: X'000101020202'. No data will be presented if loss of 
text data or loss of appearance would occur. 


e SHM, set horizontal margins, X'2BD2nn11'. We have set the left margin 
to 0.0 inch and the right margin to 8.5 inches. The right margin setting 
is ignored because set justify mode is not used. The left margin is set 
to 0 to ensure print fidelity with the original document. The operand 
field is then: X'00012FDO'. 


¢ SVM, set vertical margins, X’ 2BD2nn49’. We have set top margin to 0. is) 
inches as SCRIPT assumes that a ‘skip to channel 1' will actually be on 
the 4th print line of a new page. The bottom margin is set to 11 inch- 
es. Bottom margin is ignored in DCA Level 2. The operand field is 
then: X'O02D03DE0'. 


e S$PPS, set presentation page size, X'2BD2nn40'. We have set the width 
to 8.5 inches and the page depth to 11 inches. The operand field is 
then: X'2FDO3DE0’'. 


e SCG, set CGCSGID“, X'2BD10601' The CGCSGID is set to X'00D70108' 
(215-264 when expressed in decimal). This corresponds to the GCID 
reserved in DISOSS for the TN-chain of the 1403 printer. 


3.2.2.2 Character Translations 


Terminology 


The L2DCA SCG control introduces the term CGCSGID (Coded Graphic Charac- 
ter Set Global 1D). The CGCSGID is a definition of the relationship between the 
hexadecimal codepoints in the datastream and the graphic characters presented 
on a display or printer. CGCSGID is made up of two components: 


GCSGID Graphic Character Set Global ID. A two-byte field identifying a pre- 
defined and documented set of graphic characters. This set could be, 
for example, the characters available on a particular keyboard on on a 
particular printwheeli. 


CPGID Code-Page Global ID. A two-byte field identifying a codepage; a 
codepage defines the graphic character to be displayed for each of 
the 256 possible hexadecimal codepoints. 


There exist many more than 256 graphic characters which may need to be dis- 
played, so the CPGID provides a means of identifying which set is to be used in 
se particular datastream, and which hexadecimal codepoints are to represent 
them. | 


*“ The term CGCSGID, used in the L2DCA architecture, is equivalent to the 
term GCID used in DISOSS publications. Their meaning is described in 
"Terminology." | 
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Similarly, most displays and printers cannot support as many as 256 graphic 
characters at any given moment, so the GCSGID provides a means of selecting a 
subset from those characters available on the codepage. 


The terms used here are those used in the L2DCA architecture; other terms are 
used in other publications to refer to the same definitions. See Figure 11. 


Full Name Possible Abbreviations 


L3DCA DISOSS 


Coded Graphic Character 
Set Global ID. CGCSGID GCID 


Graphic Character 
Set Global ID. GCSGID CGCS ID 


Code Page Global ID. CPGID Code Page ID 


Figure 11. Graphic Character Set Definitions: different terms may be used 
to refer to the same entity. 


For brevity, this book uses the terms GCID, GGID and GPID. 


How DISOSS Chooses Character Translations 


The procedure used by DISOSS to choose a translate table for an output docu- 
ment is as follows: 


The GCID list provided by the output device at DIA Sign_On is searched for the 
output document GCID. If the search is successful, no translation occurs. 


Otherwise, the translate table index is searched for a translate table suitable 
for the document GPID, and an output device GCID. If the search is successful, 
then that table is used. 


Otherwise, no translation occurs. 


Required Character Translations 


There is a GCID known to DISOSS which represents the characters on the 1403 
TN print train; this is X'0OD7 0108 (00215-00264). Clearly, if we describe our 
input document with this GCID, then its content is accurately identified, and all 
components of the network have the means of knowing what our text really is. 
The disadvantage is that few components of todays DISOSS networks were 
designed to handle this GCID: thus Displaywriter, Scanmaster, DISOSS/8100 
and DISOSS/PS will all either reject a document using this GCID, or will print it 
incorrectly. Only the DISOSS Host Print function can handle it as intended. 
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This is not an unexpected situation in a DISOSS system; there are many cases 
in which a document is to be delivered to a subsystem which does not support 
the document's GCID, and DISOSS provides a set of translate tables which it 
uses to translate from the input GCID to a GCID acceptable to the receiver. 
DISOSS also provides a way for an installation to add its own translate tables to 
the standard ones. So our solution to the present problem is to provide a trans- 
late table to map the 1403 TN characters on to a GCID that is understood by all 
of the likely receiving subsystems. We could alternatively have performed a 
translation in DBTTRNI1, before passing the document into DISOSS, but rejected 
this approach for two reasons: 


1. If DISOSS will perform the translation for us, there seems no point in dugie 
cating the function. 


2. The translation cannot completely retain the appearance of the original doc- 
ument (certain box junction characters are lost, for example), and so it is 
preferable to translate only when necessary: using the DISOSS translate 
function ensures that translation occurs only when the document is about to 
be output to a device that needs it. While stored in the library, or when 
delivered to a recipient (such as another CMS/PROFS user) who can handle . 
the original GCID, the document does not undergo any translation and 
retains its original appearance. 


The output GCID we selected is X'0151 0100' (00337-00256), which is the Mul- 
ti-Lingual Codepage and is supported by all DISOSS subsystems. The translate 
table we have set up from GPID X'108' (264) to GCID X'01510100' (337-256) tries 
to preserve as much of the meaning of the printable graphics as possible. When 
no similar graphic could be found on code page X'100', a substitute was chosen. 
See "DBTTRTO1 Translate Table" on page 99. | 
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3.2.2.3 Overview of Transformations and Translations 


Performs transform DBT programs 


ora 


1403-TN GCID 


Level 2 DCA | See Note ] 
GCID O00D7-0108 | Decimal 215-264 


| Provided for DISOSS | DISOSS 
V by sample system 


Level 2 DCA 
GCID 0151-0100 


Multi-Lingual GCID 


[X—Forn routine| 
V 
1403 print | See Note 2 | 


V 


1403 print 


IDISOSS/PS 
internal format 


[form rine 


Displayable on 32/0, 
see Note 3 


DISOSS/PS 


DCA-level 2 
GCID 0151-0100 


V | DISOSS 


Figure 12. Transformations and Translations: as a document passes through 
the system, it may be transformed and translated several times. 


See Note 4 
Decimal 337-256 


Notes 


1. At this moment the document still conserves its print fidelity. If it were 
filed now, it would be stored in the library with print fidelity maintained. 
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2. As DISOSS/PS at signon time declares it can handle '1403' type documents, 
—.. DISOSS schedules the appropriate transform routine. The document will 
thus be delivered to DISOSS/PS in a form equivalent to the original 1403 
print output of Box X, apart from the character translation we provided. 


3. DISOSS/PS will do a transform to an internal format to be able to display 
documents on a 32/0 screen. This means it will, amongst other things, 
delete overprinted lines. 


4. When DISOSS/PS again gives the document to DISOSS (for a file, distribute 
etc.), it first transforms the document to a L2DCA format. 


The last two transforms do not preserve print fidelity. The following changes 
will occur compared with the L2DCA document created by our program 
DBTTRN1: | 


¢ The multibyte controls at the beginning of the DCA stream will be replaced 
by the controls provided by DISOSS/PS. 

NL controls (X'15') are replaced by RNL controls (X'06'). 

FF controls (X'0C') are replaced by RFF controls (X'3A’). 

ZICR controls (X'0D') are deleted. 

Every overprinted line is deleted. 

The document ends with RNL,FF. 


® © @ @ @ 


The main consequences of this to a DCF-generated document are: 
e Box corner characters become full-stops. 
¢ Overstruck lines are lost. This means: 


—- DCF titles are no longer bold. 

— All underscoring is lost. 

— Box intersection characters, which are made up of one character over- 
printed on another, are lost, and the box is incorrectly formed. 


Simple memos, or output from programs other than DCF, may not be seriously 
affected by these losses, but in order to allow complex DCF documents to be 
handled by our system, we had to provide an additional function. It is possible 
for the CMS/PROFS user to request that the document be filed on behalf of a 
DISOSS/PS user (usually himself), instead of being distributed to that 
DISOSS/PS user. In this way, the document is not sent to the DISOSS/PS user's 
Mail Log, but remains intact as a LZDCA document in the DISOSS library. The 
DISOSS/PS user can then search for it, add search terms and access codes if 
necessary, distribute it to other DISOSS users, or delete it. 


3.2.3 BATCH-CICS INTERFACE 


A VSAM file, which we call DBTVSQO, is chosen as the vehicle to move docu- 
ments from the RJE system into the CICS environment. Control of access to this 
VSAM file is exercised through Open/Close processing and VSAM Shareoptions 
set to 1 (which allows only one concurrent user). Both the batch program 
DBTBAT1 and the CICS transaction DBTMOV1 will try to open this file for as 
short a period of time as possible. If DBTBAT1 does not succeed on the first 
attempt, it will retry the open until it is successful. In the same circumstances, 
DBTMOV1 will end and the next initiation of DBTMOV1 will pick up any accumu- 
lated documents. Most of the time this dataset will be closed to CICS. DBTMOV1 
copies the contents of DBTVSQ0 to an identical but non-shared file, DBTVSQ1. 
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DBTVSQ0 has variable length records with a maximum record size of 6000 bytes 
(which fits well on most type of DASD). A typical 2-3 page document will then 
only take up one record on this dataset. 


DBTVSQO and DBTVSQ1 are key sequenced to simplify possible future modifica- 
tions where records may not be entered sequentially, or where concurrent 


applications may be~ writing to the same_ dataset. The common 
DBTVSQ0/DBTVSQ1 key fields are as follows: 


FIELD NAME SIZE IN BYTES DESCRIPTION 


DATE 5 Date 
TIME 9 Time 
INTTYPE 1 Interface Type identifier 
OSN 8 Office System Name 
USER 8 User name 
INTYPE 2 Input document type 
OUTYPE 2 Output document type 
SEQNO 2 Sequence Number 
CHFLAGF 1 Chain flag first 
CHFLAGL 1 Chain flag last 
TOTAL 39 
DATE This is the date in YMMDD form. Y is the least significant year dig- 
it. 
TIME This is the time in hhmmssttt form. ‘ttt’ is the milliseconds. 


INTTYPE This identifies the interface into our system. Only one is currently 
defined (the DBTVSQO shared dataset), but others might be 
required in the future. For example, some subsystems could have 
an SNA session with CICS, across-which documents could be trans- 
ferred; the receiving CICS transaction could insert the document in 
the CICS dataset DBTVSQ1, but would indicate in the document 
header INTTYPE field that the document arrived via a different 
interface. 


The combined DATE/TIME/INTTYPE field is used as a unique request identifier, 
and this should ensure that each document is stored in a series of records in 
ascending key sequence, and that duplicate keys cannot occur. This depends 
on the assumption that the probability of more than one batch job using the PL/I 
TIME pseudovariable in the same millisecond, is negligible. If this assumption is 
not considered satisfactory, the problem could be avoided by ensuring that the 
batch jobs do not execute concurrently, or that they serialise on some common 
resource before taking the timestamp. 


OSN This is the name of the distribution node of the recipient. 
USER This is the name of the recipient. 


INTYPE This identifies the datastream type of the document text. Currently 
valid values are: 


e  X'000C' --- 1403 print lines 
¢  X'0002' --- DCA Level 2 
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OUTYPE 


SEQNO 


CHFLAGF 


CHFLAGL 


This identifies the desired datastream type. _ Currently valid values 
are: | | 


e X'0002' --- DCA heel 2 


lf INTYPE is not equel to OUTYPE, then this is an indication that 
the Soc unent requires transformation. 


This is a Siaany number one less than the number of the record. 
The existence of this field ensures the impossibility of duplicate 
keys from the same request, and also causes the request records to 
be arranged in order by VSAM. 


This is ‘1’ if the record is the first af a AseumenE: ee 'O' if the 
record is not the first. All other values are invalid. It is used to 
identify the beginning of a document. 


This field is strictly unnecessary, since its value can always be 
deduced from SEQNO. It is included however, to compartmentalise 
the functions of the fields, and to make the code which manipulates 
the fields more easy to follow. 


This is 'l' if the record is the last of a document, and '0' if the 
record is not the last. All other values are invalid. It is used to 
identify the end of a document. 


This field might be used by a future version of DBTMOV1, if the 
design were changed to allow concurrent CICS/Batch access to the 
shared dataset. In that case, DBTMOV1 would not wish to start 
reading a document until it knew that DBTBAT1 had finished writ- 
ing it. 


The key contains the minimum distribution information. It could be used in a 
future design to allow partial distribution of a document in case of errors. 


Additional distribution information is present in an 80-byte header field. This 
field is the first card in the batch SYSIN stream. It is included in the first and 
last VSAM record starting at byte number 42. There is currently still plenty of 
space for more additions. The fields are as follows: 


FIELD NAME SiZe IN BYTES DESCRIPTION 


(ALANS COROT GOD COREE CURLER CUED OO CRED SERED CRUE CR UID RARE EGU GRIER COTTE tein Hae GRRE CNN KS ORES CED epee MORE CLIN REE CaO qAERN GREET GHEREND emTENISR HERON GEER 
EAD (ERE CORN GREK HELENE COURIER CONOTED COTE? ONIN) DEED ERR URENED COLES CED ORMOND ERNEE ON d CREO CARED DOLE WD CONOR eR ARATE NALD AERO NILE! OECD HOTEL KPRTN TRIE amen UN ERED 


RECTYP l Batch SYSIN record type 
PROFLAG 1 Profile format indicator 
PAGEL 3 Pagelength 
PAGEW 3 Pagewidth 
DISNAM 8 Not used 
EYECAT 6 "HEADER" Eyecatcher 
DOCNAM 15 Document name 
DISFIL ] DIA Command - Req_Dist. or File 
RESER 42 Not used 
TOTAL 80 


Below are some explanations of the header fields: 


RECTYP Batch input record format identifier. Would be used by DBTBAT1 if 


42 


it 


supported more than 1 input record format. 
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PROFLAG Profile format identifier. In our case, there is only one format, con- 


PAGEL 


PAGEW 


DISNAM 


DOCNAM 


DISFIL 


RESER 


tained on one card. Would be used by all programs in the request 
processing flow if more than one profile format was supported. Addi- 
tional profile formats would be required if and only if the total size of 
possible profile parameters exceeded 80 bytes. 


Page length. Could be used by DBTTRNn if the input pagelength 
were not ignored, or if the output pagelength were not preset. The 
precise meaning of this field would depend on the transform. 


Page width. Could be used by DBTTRNnhn if the input pagewidth were 
not ignored, or if the output pagewidth were not preset. The precise 
meaning of this field would depend on the transform. 

Not used. 

Document name. Up to 15 characters. 

Allows the user to select the DIA command to be built; valid values 
are ee for a Request_Distribution command, and ‘F’' for a File com- 
mand. 


Not used. 
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3.2.4 COMPONENTS OF THE BOX X TO DISOSS FACILITY. 


3.2.4.1 DBTBAT1 

Batch PL/I program DBTBAT1 is executes by the procedure invoked by the RJE 
batch job. Its function is to write a document input request to DBSVSQO. 

Input: JCL and instream data containing: 

e Header with user, profile, and processing information. 

e Chopped up printlines. 

Output: 6000 byte DBTVSQ0 records containing: 

¢ Key with user and processing information. 

¢ Profile information on first and last record. 


e IRS separated printlines 


3.2.4.2 DBTMOVI1 


CICS PL/I program DBTMOV1, the only program of the DBTM ipenecction:. 
moves records from the CICS-Batch shared dataset DBTVSQO, to CICS dataset 
DBTVSQ1. It calls subroutine DBTOPN1 to open DBTVSQO to CICS, and calls 
DBTCLS1 to close DBTVSQO from CICS. 

No transformations are done. 

Copied records are deleted form DBTVSQO. | 

A DBTS transaction is initiated for each request, with the 0) of the first 
record as start data to help the transform selection program locate the docu- 
ment. 


The program issues a delayed start of its own transaction to cause its periodic 
re-initiation. 


3.2.4.3 DBTOPN1 


CICS assembler program DBTOPN1 issues a DFHOC OPEN macro for dataset 
DBTVSQ0 on behalf of DBTMOV1. 


3.2.4.4 DBTCLS1 


CICS assembler program DBTCLS1 issues a DFHOC CLOSE macro for dataset 
DBTVSQ0 on behalf of DBTMOV1. | 
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3.2.4.5 DBTMST1 


CICS PL/I program DBTMST1, the first program of the DBTS transaction, 
retrieves the first-in-chain key passed from DBTMOV1, and uses it to obtain 
the whole FIC record. The fields of the record are analysed to select an appro- 
priate DBTTRNn transform routine, which is started with the FIC key as start 
data, to help locate the document in DBTVSQI1. 


3.2.4.6 DBTTRNI 

CICS PL/I program DBTTRN1 is the only transform program in the sample sys- 
tem. The input is a set of 6000 byte KSDS VSAM records from DBTVSQ1, with: 
° 39 byte key with user and processing data. 

e Profile data on FIC and LIC record. 

° IRS separated printlines. 

The output is a set of 4088 byte KSDS VSAM records to DBTVSQ1, with: 

e 39 byte key with user and processing data. 

e Profile data on FIC and LIC record. 

e L2DCA datastream. 

The first input record is located by the start data received from DBTMST1. 


The document is converted to a DCA Level 2 datastream and is written to 
DBTVSQ1 in units of a convenient size for the API queue. 


The input records are deleted from DBTVSQI1. 
Program DBTSND1 is started with the new FIC key as start data. 


3.2.4.7 DBTSND1 
CICS PL/I program DBTSND1 sends a DIA Request_Distribution or File command 
to the DISOSS API. 


The document is located on DBTVSQ1 using the FIC key retrieved from 
DBTTRN1. | 


A profile parameter block is constructed from the header. 


The DIU text segments are transmitted to the API. Each segment corresponds to 
one input record. 


An API ‘Last’ command is transmitted to initiate DISOSS processing. 
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The input records are not deleted from DBTVSQ1. This is a function of the 
response transaction. This aids problem determination by preventing the 
deletion of the transformed request in the event of an error. 


3.2.4.8 DBTRSP1 


CICS PL/I program DBTRSP1 is the only program of the response transaction 
DBTR. If the DISOSS response is normal, the request is deleted from 
DBTVSQ1. If the response is not normal, an API PURGE is issued. 


3.2.4.9 DBTSONT1 
CIcs PL/I program DBTSON1, the only program of the DBTN transaction, does 
a DIA ‘Sign_On’ to DISOSS. It is executed twice in the 'Sign_On' process. 


In the first execution it sends a 'Sign_On' to DISOSS, naming itself as the 
response transaction. 


In the second execution it starts the DBTM cycle if the DISOSS response is 
normal, and issues an API PURGE if the DISOSS response is not normal. 


Instead of being invoked via DBTN, this program can be included in the CICS 
PLT, and can thus be executed at CICS start-up. 


3.2.4.10 DBTCLNI1 

CICS PL/I program DBTCLNI1, the only ee als of the DBTC transaction, reini- 
tialises the datasets DBTVSQO and DBTVSQI1. 

The program is not strictly required, but it is Weel. especially in a develop- 


ment enviroment, because it enables these datasets to be reinitialised conven- 
iently while CICS is up. 


3.2.4.11 DBTSOF1 

CICS PL/I program DBTSOF1, the only program in the DBTF transaction, does 
a DIA 'Sign_Off' from DISOSS. It is executed twice in the ‘Sign_off' process. 

In the first execution it sends a 'Sign_Off' to DISOSS, naming itself as the 
response transaction. In the second epoear ene it issues an API PURGE if the 


DISOSS response is not normal. 


This program is not:used in the sample implementation. 
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4.0 SYSTEM DEFINITIONS FOR THE SAMPLE IMPLEMENTATION 


This section deals with the system definitions used in the course of the project 
to verify the design. Some knowledge of CICS and DISOSS table generation is 
assumed. 


4.1 CICS TABLES 


These tables are needed for the Box X to DISOSS (inbound) function, and are 
not used for the DISOSS to Box X (outbound) function. 


4.1.1 FILE CONTROL TABLE 


Below are the entries made for the VSAM datasets DBTVSQO and DBTVSQI1. 


DFHFCT TYPE=DATASET, 
DATASET=DBTVSQO, 
ACCMETH=( VSAM, KSDS 
SERVREQ= UPDATE, NEWREC , BROWSE , DELETE), 
FILSTAT= ENABLED, CLOSED 
RECFORM= VARIABLE, UNBLOCKED) , 
BUFND=3 , BUFNI=2, 
STRNO=2 
MODE=VSAM 


DFHFCT TYPE=DATASET, 
DATASET=DBTVSQ1, 
ACCMETH=( VSAM, KSDS), 
SERVREQ=( UPDATE, NEWREC , BROWSE ,DELETE) , 
FILSTAT=( ENABLED OPENED) , 
~ RECFORM= VARIABLE, UNBLOCKED) , 
BUFND=12,BUFNI=10, 
STRNO=10, 
MODE=VSAM 


The BUFND, BUFNI, and STRNO parameters determine the DBTVSQ1 buffer 
allocation. Their values should be considered carefully. 


4.1.2 PROGRAM CONTROL TABLE 


Below are the entries made for the CICS transactions. 


DCFPCT TYPE=ENTRY, TRANSID=DBTN , PROGRAM=DBTSON SIGNON 
DCFPCT TYPE=ENTRY, TRANSTID=DBTM, PROGRAM=DBIMOV1 MOVE 
DCFPCT TYPE=ENTRY, TRANSID=DBTS , PROGRAM=DBIMST1 SEND 
DCFPCT TYPE=ENTRY, TRANSID=DBTR ,PROGRAM=DBTRSP1 RESPONSE 
DCFPCT TYPE=ENTRY , TRANSID=DBTF , PROGRAM=DBTSOF SIGNOFF 
DCFPCT TYPE=ENTRY, TRANSID=DBTC , PROGRAM=DBTCLN CLEANUP 
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4.1.3) PROGRAM LIST TABLE 


A startup PLT is a list of programs to be automatically initiated during CICS 
startup. The DIA Sign_On program DBTSON1 is executed here, to ensure that a 
DIA session exists with DISOSS before any DBTS transactions attempt to dis- 
tribute documents. 


If the CICS system already has a startup PLT, the entry for DBTSON1 can be 
added to it; otherwise, a new table can be created as follows: : 


e A PLT table, similar to the one below, must be assembled. 


e The table must be defined in the PPT, as described in the section about the 
PPT in this chapter. 


e The table suffix must be specified in the SIT, as described in the section 
about the SIT in this chapter. 


Below is a sample PLT used for the initiation of DBTSON1. 


DFHPLT TYPE=INITIAL,SUFFIX=ST 
DFHPLT TYPE=ENTRY , PROGRAM=DBTSON1 
aie TYPE=FINAL 

N 


4.1.4 PROGRAM PROCESSING TABLE 


Below are the entries for the CICS programs in the PPT. 


DFHPPT TYPE=ENTRY ,PROGRAM=DBTSON1,PGMLANG=PL1-  SIGNON 

DFHPPT TYPE=ENTRY , PROGRAM=DBTMOV1 ,PGMLANG=PL1 MOVE FROM BATCH 
DFHPPT TYPE=ENTRY ,PROGRAM=DBIMST1,PGMLANG=PL1 SELECT TRANSFORM 
DFHPPT TYPE=ENTRY , PROGRAM=DBTTRN1, PGMLANG=PL1 1403 --> L2DCA 
DFHPPT TYPE=ENTRY , PROGRAM=DBTSND1 , PGMLANG=PL1 SEND TO API 
DFHPPT TYPE=ENTRY , PROGRAM=DBTRSP1,PGMLANG=PL1 API RESPONSE 
DFHPPT TYPE=ENTRY , PROGRAM=DBTOPN1 OPEN DBTVSQO 
DFHPPT TYPE=ENTRY ,PROGRAM=DBTCLS1 CLOSE DBTVSQO 
DFHPPT TYPE=ENTRY , PROGRAM=DBTSOF1 ,PGMLANG=PL1 SIGNOFF 

DFHPPT TYPE=ENTRY , PROGRAM=DBTCLN1,PGMLANG=PL1 CLEANUP 


Below is the entry for the startup PLT. This only has to be done if a new start- 
up PLT has to be created. 


DFHPPT TYPE=ENTRY , PROGRAM=DFHPLTST STARTUP PLT 
Below is an entry for a print/translate table 


DFHPPT TYPE=ENTRY , PROGRAM=DBTTRTO1,PGMLANG=ASSEMBLER, 
PGMSTAT=ENABLED , RELOAD=NO , RES=NO 
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4.1.5 SYSTEM INITIALISATION TABLE 


Below is the DFHSIT TYPE=CSECT macro option which indicates the startup 
program list table suffix. 


PLTPI=ST, 


If desired, reassembly of the SIT table can be avoided, by specifying the PLTPI 
option within a PARM parameter in the CICS startup JCL. 


4.2 VSAM DATASET DEFINITIONS 


The VSAM datasets DBTVSQO and DBTVSQ1 were created using a job with the 
following three steps: 


1. Delete the datasets in case they already exist 
2. Allocate the datasets. 


3. Initialise the datasets using the IDCAMS REPRO utility to write a dummy 
record. The first 39 bytes of the dummy records, which form the key, were 
all set to X'FF’. This ensures that the dummy record is always pushed to 
the end of the file when data is added. 


Below is the SYSIN data for the IDCAMS allocate step. 


DEFINE CLUSTER - 

(NAME(DISOSS30. DBTVSQO) - 
VOL(WTL372) - 
CYLINDERS (2 1) - 
KEYS(39 0) - 
RECSZ(5000 wet - 
SHAREOPTIONS (1 
UNIQUE) - 

CATALOG(VWTL372) - 

DATA - 


(NAME(DISOSS30. DBTVSQO.DATA)) - 


E 
( NAME(DISOSS30. DBTVSQO. INDEX)) 
DEFINE CLUSTER 
(NAME(DISOSS30 DBTVSQ1) - 
VOL(WTL372) ~ 
CYLINDERS (21) - 
KEYS(39 0) - 
RECSZ(5000 ne) - 
SHAREOPTIONS (1 
UNIQUE) - 
CATALOG(VWTL372) - 
DATA - 


A 

( NAME(DISOSS30 .DBTVSQ1 .DATA)) - 
NDEX - 
(NAME(DISOSS30.DBTVSQ1. INDEX) ) 
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4.3 DISOSS TABLE DEFINITIONS (BOX X TO DISOSS) 


4.3.1 TRANSLATE TABLES 


Most devices which are to receive L2DCA documents containing the 1403 TN 
character set will require a suitable translate/print fidelity table; we provided a 
table called DBTTRTO1, which translates from 1403 to the Multi-Lingual Code- 
page. Installing this table in DISOSS involves two steps: 


1. Assemble and link the translate table itself. The best way to create a new 
table is to modify a copy of a previously existing job; DISOSS provides 
samples on the installation tape. The job we used is shown in "DBTTRTO1 
Translate Table" on page 99. 


2. Make the new table known to DISOSS by adding an entry into the index 
table DSVS5800. Again, a sample job is provided by DISOSS; our new entry 
was: 


DSVXIDX TYPE=ENTRY , INGPID=00264 ,OUTGCID=00337-00256, 
TBLID=DBTTRTO] 


4.3.2 HOST USER PROFILE 


Below is an example of the HUP definition for the mailbox API user represented 
by our programs. The -FORUSER parameter authorises DISTO1 to file documents 
on behalf of DISOSS/PS user PSUSERO1. 


ADD USERTYPE=API , 
EXTERNAL='Mailbox API User 1 


REQPWD='1' ,DDN='DSVHOST! , SA=! nistoit. 
FORUSER=(DSVHOST , PSUSERO1) 


4.4 DISOSS TABLE DEFINITIONS (DISOSS TO BOX X) 


These HUP and PDT entries are used by the DISOSS to Box X (outbound) func- 
tion. They are not used by the Box X to DISOSS (inbound) function. 


4.4.1 HOST USER PROFILE 


If the jobcard parameters in the JOBJCL option of the DISOSS Host Definition 
job have not been set or are insufficient, then extra Host Print jobcard parame- 
ters may be specified in the accounting information field of the DISOSS user 
Host User Profile. Below is an example: 


ACCOUNT=' (P-032007) ,MSGCLASS=A ,MSGLEVEL=(1,1),CLASS=A' , 
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4.4.2 PRINTER DESCRIPTION TABLE 


Box X destinations must be defined as printers in the PDT. The PDT specifies 
the page width, page length, and a print/format procedure. Below is a sample 
entry: 


DBTPRT DSVPDT TYPE=ENTRY,PRITYPE=PRINTER, X 
LINEWD=132 , PAGEDP=66, X 
JOB=DBTPRT 


If Box X has RJE output support for multiple destinations (as, for example the 
VM support for a virtual reader for each user), then multiple PROCs will be 
required: one for each Box X destination. They could all be invoked via this 
single entry in the PDT, however; the DISOSS user would specify printer 
DBTPRTnn (where nn is two numeric digits) and DISOSS would invoke a JCL 
PROC called DBTPRTnn. Only the single entry for DBTPRT is needed in the 
PDT. 


4.5 PRINT/FORMAT PROCEDURE 


Below is an example of a simple print/format procedure. The procedure could 
be customised to produce output specific to Box X. As an example, the docu- 
ment could be converted to a PROFS note, by using the IDCAMS REPRO utility 
to wrap a header and footer around the formatter output. 


//DBTPRT99 PROC DSVCOPY=1, 

// DOCNODE=RALYDPD3 , DOCUSER=HAY , DOCUMENT DESTINATION 
He MSGNODE=RALVSMV3 ,MSGUSER=RMT99 JCL, MESSAGES ETC. 
//FORMAT EXEC PGM=DSVOL500 

//STEPLIB DD DSN=DISOSS30.DSVLOAD ,DISP=SHR 


//DOC OUTPUT COPTES=&DSVCOPY ,DEST=&DOCNODE. .&DOCUSER 
//MSG OUTPUT DEFAULT=YES , DEST=&MSGNODE. .&MSGUSER 


// 
//DSVPRINT DD SYSOUT=A DCECt RECFM=FA, RECL=1336 , OUTPUT=(* . DOC) 
//DSVMSG DD SYSQUT=A,DCB=( RECFM=FA, LRECL=133 

//DSVDUMP DD SYSOUT=A 


This procedure makes use of the OUTPUT JCL statement available with MVS/SP 
Version 1 Release 3.3. This allows NJE output routing information to be included 
in a PROC, which was not possible with the earlier JES2 /*ROUTE statement. 


4.6 IMPROVEMENTS AND ALTERNATIVE OPTIONS 


A limit to the load on CICS can be set by specifying the maximum number of 
concurrent active Mailbox tasks. This can be done by assigning a transaction 
class to Mailbox transactions in the PCT, using the TCLASS parameter, for 
example TCLASS=7, and by specifying a class activation ceiling in the SIT using 
the CMAT option, for example CMAT=(,,,,,,9,,,)- 
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It was noticed during program development that when the number of DBTS tran- 
sactions exceeded the available DBTVSQO/1 buffer allocation, they always hung 
as if in a deadlock, until enough had been force-purged to allow the others to 
continue execution. This may have been the result of bad system tuning, but 
since it has occurred in one system, it could occur in others. For this reason a 
maximum active task limit is a worthwhile precaution against overloading the 
available buffers. 
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5.0 COMMUNICATING BETWEEN PROFS AND DISOSS 


OVERVIEW 


PROFS (Professional Office System) runs under VM, and uses CMS facilities to 
create, file and retrieve notes and documents. 


We have attempted to provide a "bridge" between PROFS and DISOSS that would 
allow the PROFS user access to all the functions of DISOSS. The examples giv- 
en here are for guidance only, an account of how the problem was tackled at the 
Raleigh International Systems Centre. 


The steps involved in this part of the exercise are: 


1. 


Invoking DISOSS/PS from PROFS 

Some small EXECs are given, showing the user how to log on to DISOSS/PS 
from the PROFS main menu, send files from the A-disk to DISOSS and to 
use RDRLIST to receive and edit documents sent from DISOSS. 

Sending PROFS documents to DISOSS. 

An explanation is given on the difference between PROFS "final" documents 
and ‘draft documents. A method is given explaining how to copy a draft 
document to a final document before sending it to DISOSS. 

Sending PROFS notes to DISOSS. 

PROFS notes are unformatted and contain some characters not needed by 
DISOSS. A sample EXEC is shown, demonstrating how to edit these files, 
getting rid of the unwanted lines and hex characters, and then submitting 
the edited note to the DBTSEND EXEC, which passes it on to DISOSS. 
Loading DISOSS documents to the CMS A-disk and moving them to PROFS. 


This part explains how to load a document sent to the PROFS/CMS user's 
virtual reader from DISOSS. 
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ae ACCESSING DISOSS/PS FROM PROFS 


To access DISOSS/PS from PROFS, we nade a sale enange: to the OFS ‘$SYS- 
PROF file on the SYSADMIN 399 disk. 


For example: 


SET TITLE © | PROFESSIONAL OFFICE SYSTEM 
SET MENU 1 | 
SET PF1 'APPOINTM' Process schedules 
SET PF2 'OPENMAIL' Open the mail 
SET PF3 'SEARCH' Search for documents 
| SET PF4 'OFSNOTE' Process notes and messages 
SET PF5 'MEMO' Prepare documents 
| SET PF6 'SET FILEDOCU' Process documents from other sources 
SET PF7 'MAILLOG' Process the mail log 
| SET PF8 'MAILMAN STATUS! Check the outgoing mail 
SET PF10 'DISOSS' DISOSS tasks 
SET PF11 partes 2' Look at main menu number 2 


U 
SET aa ee MENU 3' Look at main menu number 3 
SET PF 'SET MENU 1' Look at main menu number 1 


The. DISOSS option seeaieeck by PF10. in PROFS main menu a PONOKES a simple 
EXEC (called DBTMENU) that presents this menu: | 


Send a Document to DISOSS Users 

Logon to DISOSS/PS 

Read in and send a Note to DISOSS Users 
Receive a Document from DISOSS 


& Whore 


e Option 1, "Send a Document to DISOSS Users”, builds a batch job and 
sends it via RJE to MVS. 


¢ Option 2, "Logon to DISOSS/PS", allows the user to sign on to DISOSS/PS 
via the VM PASSTHRU program. 


e Option 3, "Read in and send a Note to DISOSS Users", invokes RDRLIST 
from where the user enters the "DBTNOTE” command, as explained in "The 
DBTNOTE EXEC" on page 59. 


e Option 4, "Receive a Document from DISOSS", invokes RDRLIST from where 
ane Peer Sens the "DBTRECV" command to read a DISOSS document on to 
is is 


The DBTMENU EXEC is shown in "Sample DBTMENU EXEC" on page 155. 


The DBTSEND EXEC (Option 1), after asking the user for the filename, filetype 
and filemode, then takes a 1403 print file (usually a document extracted from 
the PROFS library), encapsulates it in an MVS job and submits it to the MVS 
system for input to DISOSS. An example of this EXEC is shown in "Sample 
DBTSEND EXEC" on page 157. 
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The DBTLOGON EXEC (Option 2) invokes VM PASSTHRU and gives the user 
direct access to CICS so that he can log on to DISOSS/PS. An example of this 
EXEC is shown in "Sample DBTLOGON EXEC" on page 161. 


RDRLIST, invoked by Options 3 and 4, is a standard VM/SP2 facility which dis- 
plays a list of the files in the virtual reader, and allows the user to enter com- 
mands alongside the name of a file on the list. In this case, the user enters 
"DBTNOTE’ or "DBTRECV" and presses PF10. 


An example of DBTRECV is shown in "Sample DBTRECV EXEC" on page 164. 
An example of DBTNOTE is shown in "Sample DBTNOTE EXEC" on page 163, 
ane an explanation of its function is given in "The DBTNOTE EXEC" on page 


5.3 SENDING A PROFS DOCUMENT TO DISOSS 


The diagram on the following page illustrates the steps involved in searching for 
a PROFS document and copying the document on to your A-disk, ready to be 
sent via DBTSEND to DISOSS. 


Our method assumes that the document being sent to DISOSS is in 1403 final 
form; that is, any SCRIPT control words and GML tags have been resolved. 
Therefore, only a PROFS "final" document is sent, not a "draft" document. 


If you need to send a PROFS draft document to DISOSS, follow the steps out- 


lined in "Changing a DCF file to 1403 Format" on page 60; this will take a copy 
of your draft document, convert it to final form, then send it to DISOSS. 
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PROFESSIONAL OFFICE SYSTEM Search for documents 
; Press PF3 | 


— 
> 
© 
a) 


Enter search terms needed 


SEARCH FOR DOCUMENTS 
2 | 01 | to locate PROFS document 


Look at list of documents found 
Press PFl 


Ww 
© 
wo 


COMPLETED SEARCH FOR DOCUMENTS 


LIST OF THE DOCUMENTS FOUND Choose document from list and 
press corresponding PF key 


4 


© 
© 


5 PROCESS THE DOCUMENT FOUND Press PF10 to 
Look at the next screen 


PROCESS THE DOCUMENT FOUND Press PF2 to Copy the document 
| into your personal storage 


1©>) 
© oe) 
© © 


Keep pressing PF12 until back to 


PROFESSIONAL OFFICE SYSTEM 
| PROFS main menu — then press PF5 


ae 
> 

| © 
an) 


PREPARE DOCUMENTS Eaeerorilenane taat was 
FO placed on A-disk and press PF3 


CO 


Press PF5 to file and send the 


9 PROCESS THE DOCUMENT © 
| document as a Final document 


0 


— 


10 | SEND THE FINAL DOCUMENT Press PF2 to erase the SELECTED 
parameter and press ENTER 


> 7 nn 
=) © 
oO oO 


11 PROFESSIONAL OFFICE SYSTEM Keep pressing PF12 until back to 
| PROFS main menu 
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Notes: 


After step 6, assuming the document is in "final" form, you will receive a mes- 
sage saying "'Dxxxxxxx MEMO’ has been placed in your personal storage," whe- 
re 'Dxxxxxxx' is a number such as: D2890001. If the document was in "draft" 
form, the message will read: "“'Dxxxxxxx SCRIPT’ has been placed in your per- 
sonal storage." In this case, the document must be converted to "final" form, as 
described in "Changing a DCF file to 1403 Format" on page 60, ready to be sent 
to DISOSS. 


39.4 SENDING A PROFS NOTE TO DISOSS 


A PROFS note is an unformatted file, containing no DCF control words or tags. 
A note can be transferred from the PROFS notelog, which is on your A-disk, by 
sending the note to your own CMS userid. PROFS will place the note in your 


virtual reader, from where it can be read in via RDRLIST and edited as neces- 
sary and transferred to DISOSS by the "DBTNOTE" EXEC. 


9.4.1 FORWARDING AN EXISTING NOTE 


We used the following steps to send a PROFS note to DISOSS/PS: 
1. From the PROFS main menu (A00), press PF4, Process notes and messages. 


2. From the PROCESS NOTES AND MESSAGES menu (E05), press PF3, Look at 
the Note Log. 


3. From the LOOK AT THE NOTE LOG menu (E08), select a note to be sent to 
DISOSS, and press the corresponding PF key. 


4. From the PROCESS THE NOTE LOG menu (E09), press PF5, Forward the 
note. 


9. From the FORWARD THE NOTE menu (E11), enter your own CMS userid 
after "Forward to:", and press PF7. 


You will receive a message saying: 


PUN FILE xxxx TO userid COPY 001 NOHOLD 
OFSNSPOO2I SENT TO <userid> AT <nodeid> 


6. Press PF12 until back to the PROFS main. menu. 


7. Press the PF key for "DISOSS Tasks" (in our case, PF10), then select 
Option 3, "Read in and send a Note to DISOSS Users", and press ENTER. 
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When the RDRLIST screen appears, enter the command DBTNOTE under "Cmd", 
alongside the PUN file created by the above steps and press PF10. 


WICRI6 = RDRLIST AO V 106 TRUNC=106 SIZE=1 LINE=1 COLUMN=1 
| Cmd Filename Filetype Class User at Node Hold Records - Date 


Tam 
WITCR16  RALYDPD3 PUN WITCRI6 #£.RALYDPD3 NONE 6 10/14 14:27: 22 | 
| 1=Help 2= Refresh 3= Quit 7=Backward 8=Forward 9=Receive 


| 4= Sort(type) 5= Parr ene 6= Sort(user)  10=Execute 11=Peek 12=Cursor 
==> 
XEDIT 1 FILE 
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9.4.2 THE DBTNOTE EXEC 


/ 


i example of the DBTNOTE EXEC is shown in "Sample DBTNOTE EXEC" on page 


DBTNOTE edits the note file that may look like the following example: 


MSG: FROM: WICR16 --RALYDPD3 TO: WICR16 --RALYDPD3 10/12/83 11:58:12 
To: WICR16 --RALYDPD3 


Subject: Forwarding | Note 08/05/83 14:57 Sending Notes 
*FORWARDED NOTE ® * * 
To: MILLAR --RALYDPD3 MILLAR --RALYDPD3 


ra Sending Notes 
ohn: 
This is a test note being sent from SYSTEM3(WICR16) to your signon. 


Cheers... Joe Bloggs 
Forwarding Note 08/05/83 14:57 Sending Notes 


For this example, the output from DBTNOTE would be: 


eye Sending Notes 
ohn: 
This is a test note being sent from SYSTEM3(WTCR16) to your signon. 


Cheers... Joe Bloggs 


This is then submitted within an MVS job via RJE, to become an entry in the 
DISOSS/PS mail-log. 


9.4.3 CREATING AND SENDING A NEW NOTE 


This procedure is similar to the previous one, with the exception of the following 
steps: 
1. From the PROCESS NOTES AND MESSAGES menu (E05), press PF1 Send a note. 


2. Enter your own CMS userid or nickname after "Send to:", fill in the note and 
press PF7 (Send). 


From here, the procedure is the same as before. 
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5.5 CHANGING A DCF FILE TO 1403 FORMAT 


When a "final" PROFS document is retrieved from the database and placed « on the 
A-disk, it will be in 1403 format. If you retrieve a "draft" document, it will be in 
DCF input format, that is, the document will consist of the text, SCRIPT control 
words and tags. ‘The document must be converted to 1403 format before it can be 
transferred to DISOSS/PS. 


You could SCRIPT the document from CMS using the PROFS starter set Profile 
OFSMPROF instead of the normal DCF Release 2 Profile - SSPROF. This entails some 
extra work, as PROFS passes tokens to the $FORMAT EXEC on the SYSADMIN 399 
disk when the document is processed normally by PROFS. 


We chose to use existing PROFS facilities to process a draft document by following 
the steps listed below: This means there are a few extra steps involved, but if 
PROFS is changed to a newer release, the method is still valid, whereas a customer 
etc EXEC runs the risk of needing to be re- -written to work with the new 
release 


1. From the PROFS main menu (AO0) press PF3 Search for documents. 


2. From the SEARCH FOR DOCUMENTS menu (DO01), enter the search terms needed 
to retrieve the draft document. 


3. From the COMPLETED SEARCH FOR DOCUMENTS menu (D03), press PF1 Look 
at list of documents found with the mail log comments. 


4. From the LIST OF DOCUMENTS FOUND menu (D04), press the corresponding PF 
key to select the draft document to be copied into the database as a final docu- 
ment. The original draft document will remain as before. | 


5. From the PROCESS THE DOCUMENT FOUND menu (D11), press PF10 Look at the 
next screen. 


6. From the next PROCESS THE DOCUMENT FOUND menu (DO09), press PF2 Copy 
the document into your personal storage. 


You will receive a message saying "'Dxxxxxxx SCRIPT’ has been placed in your 
personal storage,’ where 'Dxxxxxxx ' is a number such as: D2890001. Note 
this filename for use in next steps. | | 


7. Press PF12 until you get back to the main menu. From the main menu, press 
PFS Prepare Documents. : 


8. From the Prepare Documents menu (FOO), enter the filename (noted in step 6), 
after PF3 Change a Draft Document. Then press PF3. 


9. From the Process the document menu (FOI), press PFS File and send the docu- 
ment as a Final document. 


10. From the Send the Final. ‘document menu (FO6), press PF2 to erase the 
SELECTED parameter, and press ENTER. 


You will receive a message saying "DOCUMENT ASSIGNED 83xXXXXXXXXX". 
Press CLEAR. You are now back at the PROFS main menu (D03), and a copy of 
the draft document is now stored in the data base in final form. This final form 

document can now be retrieved and transferred to DISOSS/PS as described in 
"Sending a PROFS document to DISOSS" on page 55. 
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5.6 LOADING A DISOSS/PS DOCUMENT TO THE A-DISK AND THEN TO PROFS 
The DISOSS/PS document is transferred to CMS as a print file in the virtual reader. 
From here it can be processed in two ways: 


e Via Option 4 of the DBTMENU menu, which invokes RDRLIST and allows the 
DBTRECV command to be issued. 


¢ Via the PROFS ‘Open the Mail’ function. 


Then you can browse or edit the document, and note any information you may need 
when describing the document to PROFS later. | 


From the PROFS main menu, press the PF key to Process documents from other 
sources (usually PF6). | 


From the PROCESS DOCUMENTS FROM OTHER SOURCES menu, press PF2 Add and 
change a document file and its mail log information. 


PROFESSIONAL OFFICE SYSTEM 
PROCESS DOCUMENTS FROM OTHER SOURCES 

ADD AND CHANGE A DOCUMENT FILE AND ITS MAIL LOG INFORMATION F13 

Type the file name here: | ee eee filetype, filemode) 


the default filemode is Al) 
Type the mail jog information below, if you want it included. 


From: 


To: 


Subject: 


Comments: 


Action: Due date: 


Identifier: Type: 


Now, press ENTER 


PF9 Help PF12 Return 
Figure 13. PROFS menu to Add/Change a Document File — 


The cursor is positioned for you to enter file identifier information (file name, file 
type, and file mode). 


Communicating Between PROFS and DISOSS 61 


When you press ENTER, you will see a second ADD AND CHANGE A chia. 
FILE AND ITS MAIL LOG INFORMATION menu. 


PROFESSIONAL OFFICE SYSTEM 


i PROCESS DOCUMENTS FROM OTHER SOURCES i | 


ADD AND CHANGE A DOCUMENT FILE AND ITS MAIL LOG INFORMATION 
Press one of the following PF keys. 


PF1 Add a new document file to which you will be making changes. 
Type the number of draft copies of the document that you want to 
Save here 1 (4 is the maximum number) 

PF2 Add a document file to which no changes will be made 

PF3 Change a document file you previously added 


Press the PF key(s) for additional document file information. 
PF4 Restrict those who can see the document to you and 


the people on the document distribution list 
PF5 Assign the document distribution information 


Press ENTER to add or change the document file and its mail log information 


PF9 Help PF12 Return 


This menu requests information about how you want the document file stored. 

1. If you are filing a document for the first time and plan to change it later, use 
PF1 Add a new document file to which you will be making changes. With this 
choice, you can also specify the number of versions of this file that you want 
stored as it is revised. The system will save one version if you do not change 


the number on this menu. The maximum number of versions you can save is 
four. 


2. Use PF2 Add a document file to which no changes will be made if you are stor- 
ing it as a final document. 


3. Use PF3 Change a document file you previously stored if you are storing a 
changed copy of a document that is already in the central file. 


4. Use PF4 to restrict access to the document. 


9. Use PFS Assign the document distribution information to forward the document 
to other people. 


Press ENTER when you finish making selections. 


After you have finished, you will see the assigned document number and the mes- 
sage: 


DELETE FROM PRIVATE WORKSPACE? 
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If you type "y" or "yes" and press the ENTER key, the original document file 
will be erased. Access to the document will only be possible through PROFS. 


If you type "n" or "no" and press ENTER, the original copy will remain on your 


personal storage. 
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A.O SAMPLE SYSTEM COMPONENTS 


A.1 GENERAL REMARKS 


This section contains the code used in the course of the project to verify the 
design. These examples could form a basis for implementation at another 
location, but it should be clearly recognised that they were never intended to 
be anything other than demonstration code. They lack detailed documentation, 
adequate error notification and recovery, and professional programmers will find 
them inefficiently and unimaginatively coded. 


During the early stages of the development of these programs, an error in our 
PL/I compiler involving concatenation to varying strings required fixed strings 
to be used in places where varying strings may seem more appropriate. The 
error was later corrected, but it influenced the coding of PL/I programs 
DBTBAT1 and DBTTRN1. 


The following were set up for the CICS PL/I programs: 

e A partitioned dataset containing the control blocks DBTVSQ, and DBTOC, 
and the six DIU build subroutine control blocks listed in Appendix A, is 
included in the SYSLIB DD statement of the compile step of the CICS proce- 
dure CICEITPL. The INCLUDE option must be among the compile step PARM 
options in order for these blocks to be included. 

¢ The library containing the load modules of the DIU routines is included in 


the linkedit step of the CICEITPL procedure, tn order for these routines to 
be linked into the CICS PL/I programs. 


A.2 SOFTWARE USED TO TEST THE DESIGN 


The systems used to test the design were: 
¢ MVS/SP-JES2 Version 1 Release 3.3 

¢ CICS/OS/VS Release 1.6.1 | 

e DISOSS/370 Version 3 Release 1 


DISOSS/Professional Support Release 1 
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A.3 SOURCE LISTINGS 


Below is a summary of the common blocks, programs and JCL used by the Box X 
to DISOSS (Inbound) function. — 


DBTVSQ Common block for VSAM seats input/output overlays. 
DBTOC Subroutine communication field for open and close macro. 
DBTDOCIN Catalogued procedure invoked by batch job. 

DBTBAT1 PL/I program to place document on DBTVSQO. 

DBTMOV1 PL/I program to move request from DBTVSQO to DBTVSQ1. 
DBTOPN1 Assembler program to invoke DFHOC open for DBTMOV1. 
DBTCLS1 Assembler program to invoke DFHOC close for DBTMOV1. 
DBTMST1 PL/I program to select appropriate transform program. 
DBTTRN1 PL/I program to transform request text. 

DBTSND1 PL/I program to send request to API. 

DBTRSP1 PL/I program to process responses received from DISOSS. 
DBTSON1 PL/I program to signon to DISOSS. 

DBTCLN1 PL/I program to reset VSAM datasets. 

DBTSOF1 PL/I program to signoff from DISOSS. 

DBTTRTO1 Job to assemble and link-edit a DISOSS translate table. 
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A.3.1 


DBTVSQ COMMON BLOCK 


DBTVSQ is a common block which defines the input and output record struc- 
tures for files DBTVSQO and DBTVSQI1. 


The 3rd level fields are intended for reference to specific parameters. 
level fields are intended for larger scale manipulation of sets of parameters. 


The 2nd 


[ BRERARREEARREKERERERAEKRAAR RAKE RK AK KAR KERAAK KAKA KKK KEKE KKK A KAKKAAE REN f 


/* 


/* et VSQO/VSQ1 I/0 RECORD OVERLAYS 


J* 


THE INPUT & OUTPUT AREA POINTERS, VIPTR & VOPTR ARE DEFINED 


/* IN EACH APPLICATION PROGRAMS CONTROL BLOCK, TO FACILITATE 
/* DEBUGGING 


PTE NTC T AAG ee te Nahe Aa Pe INS We UO Pa De Wein a Oey me He Oe eRe ae Oe A TN De Oe De Pee IRIS Ray OR MeN MOIS Re AO ee SMOG Meee Pe ef 


DCL 1 VI CHAR(6002) BASED(VIPTR), /* INPUT MAP 


] 


VIG BASED(VIPTR 
2 VIKEY CHAR(39), 


2 VIDATA CHAR(5961) VARYING 


, /* 2ND LEVEL FIELDS 


VID BASED(VIPTR), /* 3RD LEVEL FIELDS 


2 VI3KEY, 
DATE CHAR(S), /* 
TIME CHAR(9 / 
INTTYPE CHAR(1), /* 
OSN CHAR(8), /* 
USER CHAR(3), /* 
INTYPE BIT ys /* 
OUTYPE BIT(16 / 
SEQNO FIXED BIN(15), /* 
CHFLAGF CHAR 1), /* 
CHFLAGL CHAR(1 


DUMLEN BIN(15 
RECTYP CHAR 
PROFLAG CHAR 
5 
) 
2 


$ 


PAGEL CHAR 
PAGEW = CHAR 
DISNAM CHAR 
EYECAT CHAR 
DOCNAM CHAR 
DISFIL CHAR 

ESER CHAR 
VIC BASED(VIPTR), 
2 VICKEY poe 


ae) 
I 
M © W& WD OD WD WD WD WD & ZW <b WD & GD WD WD WD Ww WwW WD 
4 
ZO Ww 
7) 
> 
—_— 
> 
Re OW Whee 


2 VICKEY2 CHAR(4 
2 VICDUM CHAR(2), 
2 VICHEAD CHAR(80 


DATE 

TIME 

INTERFACE TYPE 

OSN NAME | 

USER NAME FOR DISTRIBUTION 
INPUT DOCTYPE DIA-CODED 

OUPUT DOCTYPE DIA-CODED 
SEQUENCE NO X'0000' TO X'FFFF' 
CHAINING FLAG 1 

CHAINING FLAG 2 


/* PROFILE FIELDS FOR FIC/LIC/OIC 
FIXED, /* DUMMY LENGTH FIELD */ 
/* RECORD TYPE A -> 
/* RECORD SIZE IN CARD IMAGE UNITS 
/* PAGELENGTH IN LINES/PAGE 
/* PAGEWIDTH IN CHAR/LINE 
/* DISTRIBUTION ID 
"HEADER! 
, /* DOCUMENT NAME 
_ /* DISTRIBUTE OR FILE 
), /* RESERVED 


CONSTANT 


/*GENERIC KEY 

/*GENERIC KEY 

/*KEY LAST PART 

/*DUMMY LENGTH FIELD 
HEADER 


Fr Ae 
1 VIDKEY BIT(312) BASED(VIPTR) ; /*KEY IN BIT 


DCL 1 


VO CHAR(6002) BASED(VOPTR), 
VOG BASED(VOPTR), 
2 VOKEY CHAR(39), 


/* QUTPUT MAP 


/* 2ND LEVEL FIELDS 
2 VODATA CHAR( 5961) VARYING, 


VOD BASED(VOPTR), /* 3RD LEVEL FIELDS 
2 VO3KEY, 
3 DATE sete /* DATE 
3 TIME CHAR(9 /* TIME 
3 INTTYPE CHAR(1), /* INTERFACE TYPE 
3 OSN CHAR(8), /* OSN NAME 
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*/ 
as 


* 


ws 
a 


a 
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70 


3 USER CHAR(8), 
3 INTYPE BIT(16), 
3 OUTYPE BIT(16 
3 SEQNO FIXED B 
3 CHFLAGF aan 
3 CHFLAGL CHAR 

2 VO3DATA 


ee ee a 


RECTYP CHAR 
PROFLAG CHAR 
PAGEL CHAR 
PAGEW CHAR 
DISNAM CHAR 
EYECAT CHAR 
DOCNAM CHAR 
DISFIL CHAR 
RESER CHAR 


WO GO WD WD WD WD WD WD 


/* USER NAME FOR DISTRIBUTION 
/* INPUT DOCTYPE DIA-CODED 
, /* QUPUT DOCTYPE DIA-CODED 
IN(15), /* SEQUENCE NO X'O000' TO X'FFFF' 
i} /* CHAINING FLAG 1 
] /* CHAINING FLAG 2 
* PROFILE FIELDS FOR FIC/LIC/OIC 
DUMLEN Ne FIXED, /* DUMMY LENGTH FIELD “fo 
1 
3 
3 
8 
6 
15 
1) 
42 


* RECORD TYPE A -> 7 
RECORD SIZE IN CARD IMAGE UNITS 
PAGELENGTH IN LINES/PAGE 
PAGEWIDTH IN CHAR/LINE 
DISTRIBUTION ID 

'HEADER' CONSTANT 

DOCUMENT NAME 

DISTRIBUTE OR FILE 

RESERVED. 
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A.3.2 DBTOC COMMON BLOCK 


[RRERRERER EKA IK HIKER KKK KKK KR KKK KKK KKK KK KEKKKEKKKERERE | 


/* */ 
/* DBTOC: */ 
/* SUBROUTINE COMMUNICATION FIELD ee 
/* FOR OPEN AND CLOSE MACRO. */ 


J REEREEAREEAERREER EARLE EAR AKE RAK ARALAR RA KR RARER AAA K ED: 7 


DCL OPENPTR POINTER; 
1 OPENBLK BASED( OPENPTR), 
2 DBNAME CHAR(8) 


2RC  —BIT(8), 
2 FCT  BIT(24 
2 FFF BIT(24): 
[ RRRRREKKRR ARERR KEKE RAK ERE EAR EKER KEKKEK RK KKK UK KKK / 
/* * 
/* DBTMOV1 CONTROL BLOCK +/ 
* USED FOR REMEMBERING FIELDS ETC */ 


PETS, Me PONS A IGM TS Te As Be LOM MS INS Pea GN Ne ae ne aN Pe Ae RON Ne Ie Ae MeO NON 


aa QOQIPTR POINTER; 


: cee Sees 
/* KEY 39 CHARACTERS 


7 DATE HARES) v7 DATE 
3 TIME CHAR(9 J TAME 
3 INTTYPE CHAR(1), _  7* INTERFACE TYPE 
3 OSN CHAR(8), /* OSN NAME 
3 USER CHAR(8), /* USER NAME FOR DISTRIBUTION 
3 INTYPE BIT(16 /* INPUT DOCTYPE DIA-CODED 
3 OUTYPE BIT(16 /* QUPUT DOCTYPE DIA-CODED 
3 SEQNO FIXED ies /* SEQUENCE NUMBER X'0000' TO X'FFFF' 
3 CHFLAGF CHAR AY” /* CHAINING FLAG 1 
3 CHFLAGL CHAR(1), /* CHAINING FLAG 2 
2 HEAD, /* ONLY FOR FIC OR LIC 


RECTYP CHART A /* RECORD TYPE A -> 


PROFLAG CHAR(1 


PAGEW FIXED DEC 
DISNAM CHAR(8), /* UNUSED 

EYECAT CHAR(6), /* 'HEADER' CONSTANT 
DOCNAM CHAR(15), /* DOCUMENT NAME 

RESER CHAR(43), /* RESERVED FILED LENGHT 
2 COUNTER] FIXED he 5} 

2 COUNTER2 FIXED BIN(15,0 

2 VIPTR POINTER, 


1 QOQIB BASED(QOQIPTR), /*FIC OR OIC OR LIC 


/* KEY 39 CHARACTERS 
/* FIXED PART FOR ONE DOC 


WWW WW WW WIT 


2 KEY, 
3 KEY1 RAR) 
3 KEY2 CHAR 


2 HEAD CHAR(80), /* ONLY FOR FIC OR LIC 
1 QOQIC BASED(QOQIPTR), /*FIC OR OIC OR LIC 
2 KEY CHAR(39); /* KEY 39 CHARACTERS 
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}> 7* RECORD SIZE IN CARD IMAGE UNITS 
PAGEL FIXED DECC 3,0), /* DECIMAL PAGELENGTH IN LINES/PAGE 
3°0)’? /* DECIMAL PAGEWIDTH IN CHAR/LINE 


4) /* USER NAME FOR DISTRIBUTION 


a 
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A.3.3 DBTDOCIN CATALOGUED PROCEDURE 


DBTDOCIN is a sample catalogued procedure invoked by the batch job submitted 
from Box X.. 


// DBTDOC IN PROC 


J [ RRRK RIKI KIKI II KIKI IK IH III IK II II IK II IIR III IIR IK IT KICK IH IK 


fae 
fie DISOSS - BATCH INTERFACE. 


ij 

//* THIS PROCEDURE IS INVOKED BY A BATCH JOB SUBMITTED BY 
//* *BOX X'. FUNCTION IS TO REBUILD 1403 PRINTLINES FROM | 
//* INPUT CARD IMAGES, CONCATENATE THEM IN LARGE PHYSICAL 
//* RECORDS, AND INSERT THEM IN THE BATCH-->CICS INTERFACE 
//* DATASET DBTVSQO. 


ALLE ORT OTT 
//* 

//INSERT EXEC PGM=DBTBAT1 

//STEPLIB DD DSN=DISOSS30.DBT.LOADLIB,DISP=SHR 

// DSN=F5.PLIBASE ,DISP=SHR 

//SYSPRINT DD SYSOUT=A 

//LOGFILE DD SYSOUT=A 

//BUFFER DD DCB=(RECFM=V,LRECL=6006), ee (1,1)),UNIT=SYSDA 
//NSQO DD DSN=DISOSS30.DBTVSQO, DISP=SHR 


// 
//* INPUT DDNAME IS DOCIN 
ae 


* £4 HHH KH 


CO 
a 
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A.3.4 DBTBAT1 PROGRAM SOURCE 


This program uses its own DBTVSQ1 output record definitions. The reasons for 
this are historical. There is no reason why they should not now be changed to 
conform with DBTVSQ. 


If the dataset DBTVSQO is open to the CICS transaction DBTM, the program will 
repeatedly branch to the label OPENFILE to repeat its open attempts until suc- 
cessful. The use of a loop to enforce a delay period between open attempts is 
unsatisfactory because it consumes considerable processing resource. It could 
be replaced with an assembler subroutine to issue a WAIT macro. 


The sample program does nothing to avoid two batch jobs using the PL/I TIME 
pseudovariable during the same millisecond, which could cause duplicate keys on 
the VSAM datasets. This problem can be solved in the following way. A recur- 
sive on-ILLOGIC branch to a routine could be set up before the FIC write. The 
routine could either add one to VSQD.KEY.TIME, or could reassign the TIME 
psudovariable. Continued attempts would then be made until a unique key was 
found. Alternatively, an assembler subroutine could issue an ENQUEUE before 
getting the date and time. 


The record of error codes in the file LOGFILE was found genuinely useful dur- 
ing debugging, although it was intended merely as an example of a way to begin 
error detection. 


DBTBAT1: PROC OPTIONS(MAIN) ; 


J REEAEREEEREEREER ER ERA ALAR EAA ERE KREAR AAA EKA AA AA HK / 


ag 7, 
/* DBIBAT1 15/09/1983 aA 
7* PL1 PROGRAM SOURCE DBTBAT1 FOR PROCEDURE DBIDOCIN */ 
ie CALLED BY BATCH JOB SUBMITTED FROM BOX X ay 
/* INPUT: JCL INSTREAM DATA a 
ae 3 HEADER WITH USER, PROFILE, AND PROCESSING DATA */ 
ee 2) CHOPPED UP PRINT LINES : 

/* QUTPUT: KEY SEQUENCED 6K VSAM RECORDS TO DBTVSQO ad 
f* 1) KEYS WITH USER AND PROCESSING DATA i 

7* 2) PROFILE DATA ON FIRST AND LAST RECORD a7 
ji 3) IRS SEPARATED PRINTLINES ey 


/* QUTBOUND RECORDS ARE FIRST WRITTEN TO A BUFFER, AND */ 
/* THEN COPIED TO DBTVSQO, TO MINIMISE THE PERIOD OF an 
/* TIME DURING WHICH DBTVSQO IS HELD OPEN */; 


KKKKK KKK KK IKK KKK KIKI KKK IK KK IKK KKK I KKK KKK KKKKKKKKEKKKKKKKK 


DCL (DATE, TIME,MIN,SUBSTR,UNSPEC ,LENGTH ,MAX,ADDR) BUILTIN; 


hiatal lg a DATASET DEFINITIONS ----------------- of 
DCL DOCIN FILE RECORD, /* INPUT FILE */ 
BUFFER FILE RECORD, /* TEMPORY BUFFER FILE aA 
LOGFILE FILE RECORD, /* ERROR LOGGING FILE ae 4 

VSQO FILE RECORD OUTPUT DIRECT BUFFERED KEYED 
ENVCVSAM); /* OUTPUT FILE 7, 
/* THE DCB FOR BUFFER IS DCB=(RECFM= V, LRECL=6006 ) */ 
/* THE DCB FOR LOGFILE IS DCB=RECFM=F,LRECL=80,BLKSIZE=80) */ 
irda mick GRA DOCIN HEADER RECORD LAYOUT --------------- */ 


DCL 1 HEADER, 
3 HOSN CHAR(8), /* OSN NAME */ 
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/* USER NAME FOR DISTRIBUTION */ 


3 HUSER  —-CHAR(8), 
3 HINTYPE CHAR(2), /* INPUT DOCUMENT TYPE */ | 
3 HOUTYPE CHAR(2), /* OUTPUT DOCUMENT TYPE */ 
3 HRECSIZE CHAR(1), /* NUMBER OF 80-BYTE CARD */ 
| /* IMAGES PER PRINT LINE */ 
3 HRECTYPE CHAR(1), /* RECORD TYPE */ 
3 HPROFLAG CHAR(1), /* PROFILE FLAG */ 
3 HPAGEL CHAR(3), /* PAGELENGTH IN LINES/PAGE */ 
3 HPAGEW CHAR(3), /* PAGEWIDTH IN CHARS/LINE */ 
3 HDISNAM CHAR(8), /* RESERVED */ 
3 HEYECAT CHAR(6), /* 'HEADER' CONSTANT */ 
3 HDOCNAM CHARE AL). , /* DOCUMENT NAME */ - 
3 HDISFIL CHAR(1), /* FILE OR DISTRIBUTE */ 
3 HRESER CHAR( 21) /* RESERVED */ 
[eee VoO0 RECORD OVERLAYS (ee sese sates aaese sae a 4 
DCL VSQPTR POINTER; 
DCL VSQBASE BASED( VSQPTR) ae te BASIC OVERLAY AREA */ 
1 VSQD BASED(VSQPTR), /* ELDS a 
2 KEY, " i 
3 DATE CHAR(5), /* DATE wa 
3 TIME CHAR(9), /* TIME ws 
3 INTTYPE CHAR(1), /* INTERFACE TYPE wd 
3 OSN CHAR(8), /* OSN NAME wa 
3 USER CHAR(8), /* USER NAME FOR DISTRIBUTION */ 
3 INTYPE BIT(16), /* INPUT DOCTYPE DIA-CODED 7 
3 QUTYPE BIT(16), /* QUPUT DOCTYPE DIA~CODED 7, 
3 SEQNO FIXED BIN(15), a SEQUENCE NUMBER X'0000' TO X'FFFF' = */ 
3 CHFLAGF CHAR is a 1) /* CHAINING FLAG 1 */ 
3 CHFLAGL CHAR(1) INIT(' /* CHAINING FLAG 2 . 
2 DUMDATA CHAR(5961), /* DUMMY DATA FIELD x] 
1 VSQA BASED(VSQPTR), /* LEVEL 2 FIELDS | “aes 
2 KEY CHAR(39), i KEY | ws 
2 DATA CHAR( 5959) VARYING; /* RECORD DATA 5 


DCL LENPOINT POINTER, 
LENBIN FIXED BIN(15 ,0) INIT(1) pAsEDrLENpOuEY? 


LENCHAR D( LENPOINT 
pe cen dense tae een Sere PROFILE OVERLAYS Soren oreo e a ef 
DCL PRPTR POINTER; /* PROFILE OVERLAY POINTER */ 
DCL 1 PROFILED BASED( PRPTR) /* PROFILE DETAIL */ 
3 RECTYP CHAR( 1), * RECORD TYPE 7h 
3 PROFLAG CHAR(1), is RECORD SIZE IN CARD IMAGE UNITS ny 
3 PAGEL CHAR(3), | /*NOT DECIMAL PAGELENGTH IN LINES/PAGE */ 
3 PAGEW -CHAR(3), /*NOT DECIMAL PAGEWIDTH IN CHAR/LINE we 
3 DISNAM CHAR(8), /* UNUSED x7. 
3 EYECAT CHAR(6), /* 'HEADER' CONSTANT es 
3 DOCNAM SHARE?” /* DOCUMENT NAME a 6 
3 DISFIL CHAR(1 /* DISTRIBUTE OR FILE my: 
3 RESER CHARtBOS” /* RESERVED FILED LENGHT */ 
PROFILEA CHAR(80 eee /* PROFILE GENERAL AREA at 4 
See een = hen Sansa e a VARUABLES (S92 See -eseer=sae=saee= ag 
DCL CARD CHAR(80), /* 80-BYTE I/O CARD IMAGE as 
VSR CHAR 6002) VARYING, /* VARYING OUTPUT STRING */ 
PL CHAR(500) VARYING, /* PRINT LINE 7 
PLPTR RECA} ,0) FIXED, /* PRINT LINE POINTER */ 
ERROR DEC(4) FIXED INIT(O), /* ERROR CODE ws 
NL CHAR(1), /* NEWLINE CHARACTER */ 
NLBP POINTER,/* NEWLINE BIT OVERLAY POINTER a) 4 
NLB BIT(8) BASED(NLBP) INIT('00011110'B), 
/* NEWLINE BIT OVERLAY is 
N DEC(7) FIXED INIT(Q), /* SCRATCH VARIABLE */ 
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N1 meet FIXED INIT(O); /* SCRATCH ey ae oy 


ON ENDFILE (DOCIN) GOTO FINAL; 

ON ENDFILE (BUFFER) GOTO STOP; 

ON RECORD (BUFFER) GOTO CONTI; 

ON UNDEFINEDFILE(VSQO) GOTO OPENFILE; 

ALLOCATE NLB; 

ALLOCATE VSQBASE; 

ALLOCATE PROFILED; 

ALLOCATE LENBIN; 

NLBP = ADDR(NL); 
| NLB = '00011110'B; 
/*------------- CONSTRUCT VSAM HEADER ---------------- */ 
JL EEEEAAARERE RICA RELA IAA RA AKIRA HRA AAA IK A A 
/* THE MINIMUM OF PROCESSING IS PERFORMED HERE. */ 
/* INPUT PARAMETERS WHICH CAN HAVE ONLY ONE «/ 
/* MEANINGFUL VALUE ARE IGNORED ol 
DOSISOSI CICS IOI OIC OCI TOO IIIT ITO TOI III III ITI I IIIS. 

KEY .DATE=SUBSTR( DATE, 2) ; 

KEY. TIME=TIME; 

KEY. INTTYPE='A'; 

READ FILE oD) INTO (HEADER); 


OSN = HOS 
IF OSN = ' ' THEN OSN = 'DSVHOST . 

USER = HUSER ; 

IF USER = ' ' THEN USER = 'HDVFO2 '; 

INTYPE = '0000000000001100'B; /* TO BE DEP ON INTYPES */ 
OUTYPE = '0000000000000010' B: /* TO BE DEP ON OUTYPES */ 
RECTYP = A /* TO BE DEPENDENT ON RECTYPES */ 
PROFLAG = ‘A’; /* TO BE DEPENDENT ON PROFLAGS */ 

PAGEL = HPAGEL; 

PAGEW = HPAGEW; 

DISNAM = HDISNAM; 

IF DISNAM = ' ' THEN DISNAM = USER; 


YECAT ; 
IF EYECAT -= 'HEADER' THEN GOTO ERROR1; 
DOCNAM = HDOCNAM; 
DISEIL.=HOISEI LE. 
CHELAGP =." 1": 


CHFLAGL = 'O'; 
IF HPROFLAG = 'A' THEN GOTO TEXT; 
grea PROCESS PROFILE TYPE 'B' DATA ----------- */ 
* 
ie x 
hs (TO BE CONTINUED .... —) */ 
/* a) 
/* */ 
[*---------------- EXTRACT NEXT LINE ----------------- */ 
TEXT: PL="! 
N = UNSPEC(HRECSIZE) - 15*16; 


DO Nl = 1 70 N; 
READ FILE (DOCIN) INTO (CARD); 
PL = PL |} CARD 
END; /* Nl x] 
PLPTR = LENGTH(PL); 
| ia re acannon at a REMOVE TRAILING BLANKS ------------*/ 
NEXTCHAR: IF SUBSTR(PL,PLPTR,1)-=' ' | PLPTR=1 THEN GOTO REMOVE; 
PLPTR = PLPTR - 1; | 
GOTO NEXTCHAR; 
Da a al ica REMOVE UNPRINTABLE CHARACTERS ----- a 
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REMOVE: PL = SUBSTR(PL,1,PLPTR); 
Nl = PLPTR + 1; 
PREVCHAR: N1 = N1 - 1; 


IF Nl < 2 THEN GOTO ADDLINE; 
IF UNSPEC(SUBSTR(PL,N1, ao < 
PL = SUBSTR(PL,1,N1-1) |]! y rT  SUBSTR(PL, N1+1); 
GOTO PREVCHAR;: 
[kno-------------- TEST FOR FULL OUTPUT RECORD ------- */ 
ADDLINE: IF LENGTH(DATA) + LENGTH(PL 
| 6000-39-80-2+1 THEN GOTO SAMEREC; 
[ka---------- INCLUDE PROFILE DATA IF FIC/LIC/OIC ~~--*/ 
LASTONE: IF SEQNO=0 | CHFLAGF='1' | CHFLAGL='1' THEN 
| DATA = PROFILEA || DATA; : 
[kn--------------- WRITE OUTPUT RECORD ---------------------- */ 
LENBIN = LENGTH(VSQA.DATA); a 
VSR = VSQA.KEY || LENCHAR || VSQA.DATA; 
WRITE FILE (BUFFER) FROM (VSR); 
CONT1: IF CHFLAGL = '1' THEN GOTO COPY; 


CHFLAGF = '0'; 

DATA = '! 
a gaa APPEND PRINT LINE TO RECORD UNDER CONSTRUCTION -*/ 
SAMEREC: DATA = DATA || PL [| NL; 

GOTO TEXT; 
eae: REPEAT ATTEMPTS TO OPEN VSQO UNTIL SUCCESSFUL ---*/ 


OPENFILE: DO N = 1 TO 999; 
CARD = 'THIS IS AN UNSATISFACTORY WAY OF WAITING' ; 


END; 
OPEN FILE( VSQO) OUTPUT; 
GOTO AGAIN | 
/*=--SET CHAINFLAG LAST TO REMEMBER TO STOP AFTER NEXT WRITE - */. 
FINAL: CHFLAGL = '1!' | 
GOTO LASTONE; 
[kann--------- COPY BUFFER INTO REQUEST QUEUE -------- */ 
COPY: CLOSE FILE(BUFFER): 
ON RECORD aa GOTO CONT2; 
OPEN FILE(BUFFER) INPUT; 
OPEN FILE(VSQO) OUTPUT; 
AGAIN: READ FILE(BUFFER) INTO (VSR); 
CONT2: IF LENGTH(VSR) < 41 THEN 2070 ERROR3; 
VSQA.KEY = SUBSTR(VSR,1,39): 
WRITE FILE(VSQO) | FROM (VSR) KEYFROM(VSQA. KEY); 
GOTO AGAIN; | 
/*------ WRITE ERROR MESSAGE 10; LOGE ILE G=ess=se see 73 > */ : 
ERROR3: ERROR = MAX(ERROR,3); /* BUFFER RECORD TOO SHORT } */ 
ERROR2: ERROR = MAX(ERROR,2); /* FEWER KEYS THAN RECORDS  */ 
ERROR1: ERROR = MAX(ERROR, 1 /* EYECATCHER HAS SLIPPED !!! */ 
CARD = 'ERROR CODE: - 


RROR ; 
IF Shea rg WRITE FILE (LOGFILE) FROM a 
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A.3.5 DBTMOV1 PROGRAM SOURCE 


DBTMOV1: PROC OPTIONS(MAIN REENTRANT) ; 


LER RRRIRER RHE KER ER KEK IK ERK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK | 


/* iy 
ie DBTMOVI: 17 AUGUST 1983 */ 
j* - PLI CICS COMMAND LEVEL PROGRAM wg 
he - GET AUTOMATICALLY INITIATED EVERY ws 
i 5 MINUTES ad 
/* - SUBROUTINES LINKED VIA CICS: DBTOPN1 Ay 
a DBTCLS1 os 
/* - INPUT KEY SEQUENCED 6K VSAM RECORDS OF gd 
7 DBTVSQO, KEY IN FIRST 39 BYTES My, 
he - QUTPUT KEY SEQUENCED 6K VSAM RECORDS TO */ 
/* DBTVSQ1, KEY IN FIRST 39 BYTES */ 
hi - NO DATA TRANSFORMATIONS ARE DONE wd 
i - COPIED RECORDS ARE DELETED FROM DBTVSQO i) 
/* - THE PROGRAM CHECKS IF DBTVSQO IS OPEN aw 
f* IF SO IT ASSUMES THAT DBTBAT1 IS RUNNING “7 
iss STOPS TO RETRY IN 5 MINUTES TIME WA 
{> ~ FOR EVERY DOCUMENT (CHANGE IN FIRST 35 BYTES */ 
ce OF KEY) IT INITIATES CICS TRANSACTION DBTS vA 
i (PROGRAM DBTMST1) WITH THE KEY OF THE FIRST */ 
hs RECORD OF THE DOCUMENT AS THE START KEY a7 
{= ~ CLOSES DBTVSQO a 
/* - STARTS ITSELF IN 5 MINUTES uy 


POTTER Re ME IAM CM ION Hey Me MOM eC We POE TE OIE eI NE MO AI ICE I ae ey, 


DCL (LENGTH,STG,CSTG,ADDR,MAX) BUILTIN; 


“INCLUDE DBTVSQ: f* DBTVSQO AND DBTVSQ1l = */ 
OOOO I IOI IOI ITO II IOI II II III I IT III I III II 

/* “ 

/* DBTOC: CONTROL BLOCK at 

ae USED FOR REMEMBERING KEY, HEADER a 

iss AND POINTERS TO OTHER CONTROL BLOCKS */ 


MAAN KIER IM AAI HI PONT MM YEN RIN HA IS IEE IE I HEA A EA A If 


aa QOQIPTR POINTER; 
: rest ites eae 


KEY 39 CHARACTERS ws 
7 “DATE CHAR(5 /* DATE ay 
3 TIME CHAR(9 /* TIME we 
3 INTTYPE as. /* INTERFACE TYPE ws 
3 OSN CHAR(8), /* OSN NAME , 27 
3 USER CHAR(8), /* USER NAME FOR DISTRIBUTION ag 
3 INTYPE BIT(16 /* INPUT DOCTYPE DIA-CODED wa 
3 OUTYPE BIT(16 /* QUPUT DOCTYPE DIA-CODED */, 
3 SEQNO FIXED are /* SEQUENCE NUMBER X'0000' TO X'FFFF' */ 
3 CHFLAGF SHARE LY: /* CHAINING FLAG 1 m 
3 CHFLAGL CHAR(1), /* CHAINING FLAG 2 : wd 
2 HEAD, /* ONLY FOR FIC OR LIC af 
3 RECTYP SHARES: /* RECORD: TYPE A: == aA 
3 PROFLAG CHAR(1), /* RECORD SIZE IN CARD IMAGE UNITS “7 
3 PAGEL CHARESS” /* DECIMAL PAGELENGTH IN LINES/PAGE * 
3 PAGEW CHAR(3), /* DECIMAL PAGEWIDTH IN CHAR/LINE a, 
3 DISNAM CHAR(8), /* UNUSED wa 
3 EYECAT CHAR(6), /* 'HEADER' CONSTANT | ar 
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3 DOCNAM CHAR(15), /* DOCUMENT NAME */ 


3 RESER CHAR(43);  /* RESERVED FILED LENGHT / 

DCL VIPTR POINTER, /* POINTER TO INPUT AREA */ 

VOPTR POINTER, /* POINTER TO OUTPUT AREA / 

OPENPTR POINTER, /* POINTER TO OPENBLK COMMAREA x/ 

1 Q0Q1B BASED(QOQ1PTR), § /* OVERLAY x/ 

2 KEY, /* KEY 39 CHARACTERS | */ 

3 KEY1 oe /* FIXED PART FOR ONE DOC */ 

3 KEY2 CHAR(4) 7* USER NAME FOR DISTRIBUTION — x/ 

2 HEAD CHAR(80), /* ONLY FOR FIC OR LIC */ 

1 QOQIC BASED(QOQ1PTR), | /*FIC OR OIC OR LIC */ 

2 KEY CHAR(39); -/* KEY 39 CHARACTERS ” 7 
HK HEH HH HHH HHH KK IK KKK KKK KK KKK KKK IKK KKK IK HK KKH KK KE KK EK | 
pL SUROUTNG commcatiN FIED 
/* LAYOUT CORRESPONDS WITH DATA */ 
/* DEFINITION FOR DFHOC MACRO x/ 


J RREREKEREKRKEKK KKK KKK KKK KKK KK KKK KEK EEK KKK KEK KKK KKK / 


DCL : 
1 OPENBLK BASED(OPENPTR), 


2 DBNAME CHAR(8), /* DATA BASE NAME TO BE OPENED/CLOSED 4 
2 RC BIT(8), _ /* RETURN CODE FIELD X'00' OKAY we 
2 FCT BIT 544’ /* FCT ENTRY ON RETURN ee 
2 FFF BIT( 24); /* X'FFFFFF' MARKS END OF CONTROL BLK */ 


Jf KER RIK AMA ORIN I IM NOMA AN MRM ION AC IER a ee ee ee ee 


/* GET STORAGE AREAS */ 

foo Te OM IE HR LON IN Ie eee Ie Pe I eG IS BO Us ee ery ee TG NIN Pe Ry Oa NG ee DS 
EXEC CICS GETMAIN SET Q0g1PTR) ener INITIMG( '00000000'B) ; 
EXEC CICS GETMAIN SET(OPENPTR) LENGTH 15) INTIME qo00000' 8): 
EXEC CICS GETMAIN SET(VIPTR) LENGTH(6002) INITIMG('00000000'B); 


J RRERAEAARERAAARERKRAEK ERE RARER ANAK AS ER HM MIR A HH 


/*-------------- OPEN MACRO ATTEMPT ---------------- “) 
[J RRRKEKKKHK KKK AK IKK IK KKK IK IKE KKK EK KKK KEKE KKK RE KK ERR EKER / 
DBNAME = 'DBTVSQO '; 
FFF = (3)'11111111'B; 
EXEC CICS LINK PROGRAM( 'DBTOPN1' ) COMMAREA( OPENBLK) LENGTH( 15); 
F RC -= '00000000'B THEN GOTO CLOSE 


Pr AE eer ee se re tener eter id ieee renter Tre, 


/* START READING DATASET AT BEGINNING */ 
[RR RK RRR KK IKK KKK KKK KKK KKK IK HK KKK KKK KICK IK KKK HK KICK KK KKK 
SANERICS STARTBR DATASET( 'DBTVSQO') KEYLENGTH(0) RIDFLD(VIKEY) 


NEXTREC: EXEC CICS HANDLE CONDITION AD") INTCU YTS: 
EXEC CICS READNEXT DATASET('DBTVSQO') INTOC(VI 


RIDFLD(VIKEY): 

IF VIDKEY = ((39)'11111111'B) THEN GOTO STOP; /* DUMMY RECORD HIT*/ 
IF VICKEY -= QOQ1B.KEY.KEY1 /* DOC# CHANGE x/ 
Ra \CHFLAGF 7= '1! /* INPUT NOT FIC */ 


N DO; 
/* NO FIC ON NEW DOCUMENT ERROR CODE TO BE ADDED */ 
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END; 

IF VI3KEY.CHFLAGF = '1' /* NEW DOCUMENT WITH FIC */ 
& Q0Q1.CHFLAGL >= ‘1! /* SHOULD HAVE HAD LIC wd 
THEN DO; KEY -= '! /* ONLY ON FIRST DOCUMENT */ 


END. NO LIC ON LAST DOCUMENT ERROR CODE TO BE ADDED */ 


/* SAVE KEY FOR CHECK OF FIC/LIC */ 
QOQIC.KEY = VIKEY; 
/* SAVE HEADER FOR LOST LIC RECOVERY a 
IF VI3KEY.CHFLAGF= '1' THEN QOQIB.HEAD = VICHEAD; 
/*--------- COPY RECORDS TO DBTVSQ1 ---------- x]; 


EXEC CICS WRITE DATASET('DBTVSQ1') FROM(VI) 
RIDFLD(VIKEY) LENGTH(39+2+LENGTH(VIDATA)); 
JOGOS III I IIIS ICICI I III II TOO I I I ITO II II IIIA 
/* AT END OF DOCUMENT START DBTTRNI */ 
AND DELETE RECORDS ON DBTVSQO */ 


[ARR REAR REAR REAR RNRRA REARDAN RE REAR] 


THEN BOL .CHFLAGL='1' 7™ LIC. 2 ed 
IF VI3KEY.CHFLAGF += '1! /* REBUILD FIRST KEY */ 
THEN DO; : 


VI3KEY. SEQNO = 0; 
VI3KEY.CHFLAGF = '1'; 


END; 
/*--------- MASS DELETE DBTVSQO DOCUMENT------- «/ 
EXEC CICS DELETE DATASET( ‘DBT VSQO') RIDFLD( VICKEY) 
KEYLENGTH(35) GENERIC; 


/*--------- PASS KEY 10 DBTTRNI --------------- */ 
EXEC CICS START, TRANSID(‘DBTS') FROM(VIKEY) LENGTH( 39); 

/* TERMID('L430') */ ONLY FOR TESTING */ 
VI3KEY.SEQNO = Q0Q1.KEY.SEQNO; /* $0 PREVENT TLLOGIC ON READ */ 


VI3KEY.CHFLAGF = Q0Q1.KEY. CHFLAGF; /* TO PREVENT ILLOGIC ON READ */ 


END; 
GOTO NEXTREC; 
STOP: 
EXEC CICS ENDBR DATASET( 'DBTVSQO'); 
[*--------- CLOSE DATASET --------------------- */ 


LOSE: 
EXEC CICS LINK PROGRAM( | DBTCLS1') COMMAREA(COPENBLK) LENGTH(15); 
IF RC -= '00000000'B THEN GOTO ERR3; 


GOTO LAST; 
ERR3: GOTO LAST; /* OPEN/CLOSE ERROR */ 
| ae ates START ITSELF IN 5 MINUTES AND STOP anon / 
LAST: 

* a A 
ie RESTART OF DBTM COMMENTED OUT FOR TESTING ...WBW */ 
/* EXEC CICS START TRANSID('DBTM') INTERVAL( 000500); i) 
i 7 
j* ay A 


END; 
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A.3.6 DBTOPN1 PROGRAM SOURCE 


OPN TITLE '*DBTOPN1* - PERFORM CICS OPEN FOR DATASET*'! 
PRINT NOGEN 
GBLB &DFHEIMX INDICATE MIXED MODE 
&DFHEIMX SETB 1 INDICATE MIXED MODE 
COPY DFHCSADS COPY CSA DEFINITION 
COPY DFHTCADS COPY TCA DEFINITION 


SPACE 
DBTOPN1 CSECT 
KKKKKAK KKH KKK HK KKK KKK KK IKK KKK KKK KKK KKK KKK IKK KKK KKK KKK KKK KKK KKK KKK KKKKKKKK 
* DBTOPN1: ee 
* ASSEMBLER MIXED MODE TRANSACTION is 
‘ SUBROUTINE TO DO A CICS OPEN : 
* INPUT PARMLIST: - 
* -> QPENBLK CONTROL BLOK POINTER CONTAINING: is 
. -> DATSETNAME (8 BYTES) i. 
7 -> RC FIELD 1 BYTE) i 
iy -> FCT FIELD (3 BYTES a 
: -> FFF FIELD (3 BYTES) TO INIDCATE END OF BLOCK : 
* — QUTPUT: RC HAS RETURN CODE. e 
. = 8 : BAD RETURN FROM OPEN MACRO ™ 
: = 0 : OKAY | 
KHKKKKKKKHK KKK KKK KEK HK KKK KKK KKK KKKKK KKK KKK KK KKK KKK KKK KKK KKKKKEKKKKKKKKK 

SPACE 

PRINT ON 

L 8, DFHEICAP OPENBLK ADDRESS 

SPACE 

DFHOC TYPE=OPEN, ONLY OPEN 

DATASET= DATABASE, THIS IS FOR A VSAM DATASET 
LISTADR=8 POINTER TO PARM LIST 

EXEC CICS RETURN 

EJECT 

PRINT ON 

END 
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A.3./ DBTCLS1 PROGRAM SOURCE 


CLO TITLE '*DBTCLS1* - PERFORM CICS CLOSE FOR DATABASE*'! 
PRINT NOGEN 
GBLB &DFHEIMX INDICATE MIXED MODE 
&DFHEIMX SETB 1 INDICATE MIXED MODE 
COPY DFHCSADS COPY CSA DEFINITION 
COPY DFHTCADS COPY TCA DEFINITION 
DBTCLS1 CSECT | 
HK IKK IK KK KK KKK KKK KICK KKK KKK HK KK HK KK KKK KKK KKK KKKKKKKK KKK KKK KKK KKK KKK KI KKK 
* DBICLS1 
ASSEMBLER SUBROUTINE, MIXED MODE TRANSACTION 


SUBROUTINE TO DO A CICS CLOSE 
INPUT PARMLIST: 


* 


-> DATSETNAME (8 BYTES 
RC FIELD 1 BYTE) 
-> FCT FIELD (3 BYTES 
-> FFF FIELD (3 BYTES) INDICATING END OF BLOCK 


OUTPUT: RC HAS RETURN CODE. 
8 : BAD RETURN FROM OPEN MACRO 
O : OKAY 


KHKIKKKKKKKHK KKK KKK HK KI KKK KKK IKK KKK KKK IKK KKK KK KKK IKK KKK KK KKK KK KKKKKKKKKKKKK 


SPACE 

PRINT ON 

L 8 , DFHEICAP OPENBLK ADDRESS 

DFHOC TYPE=CLOSE, ONLY CLOSE X 
DATASET=DATABASE, THIS IS FOR A VSAM DATASET X 
LISTADR=8 POINTER TO PARM LIST 

EXEC CICS RETURN 

EJECT 

PRINT ON 

END 


-> QPENBLK CONTROL TES) POINTER CONTAINING: 


* * eH HE He HE Ke KH OR 
t 
V 
* * * EH EH HH HH Ke He KH KH OS 
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A.3.8 DBTMST1 PROGRAM SOURCE 


DBTMST1: PROC OPTIONS(MAIN) ; 


[ERE EAEREAREA EAS SANNA AE RSV ER NERS ELE ERE NEL ERE RAR NENT an 


/* DBTMST1: DBTMST1 PROGRAM SOURCE FOR TRANSACTION DBTS a 


is INPUT: 39-BYTE FIC KEY START DATA 3 iy 
ip OUTPUT: 39-BYTE FIC KEY START DATA uy 
;* FUNCTION: 1) RETRIEVE VSQ1 ieee FIC KEY */ 
hs 2) OBTAIN FIC RECORD asf 
f* 3) DETERMINE CORRECT TRANSFORM PROGRAM */ 
aa FROM KEY AND PROFILE PARAMETERS ay 
ye 4) TRANSFER CONTROL TO CORRECT os 
ie TRANSFORM, PASSING FIC KEY */ 


[RK HKK KK KHER ERK KK KKK KKK KKK KKK KK IKK KK KKK KKK KKK KKK KKK KKK KKK K / 


“INCLUDE DBTVSQ; /* --- See T/O0 OVERLAYS --- */ 
DCL (LENGTH, STG, CSTG,ADDR) BUILTIN; 
DCL KEYLEN FIXED BIN(15) INIT(39); 
DCL VOPTR POINTER, 
VIPTR POINTER; 
/* -=-= ALLOCATE INPUT RECORD STORAGE -~-- * 
EXEC CICS GETMAIN SET(VIPTR) LENGTH(6002) INITIMG('00000000'B); 
j* = RETRIEVE (FLC KEY ==) 27 
EXEC CICS RETRIEVE INTO(VIG) LENGTH(KEYLEN) ; 
/* <== - OBTAIN: FIC. RECORD. === 
EXEC CICS STARTBR DATASET( 'DBTVSQ1' ) RIDFLD(VICKEY) 
KEYLENGTH(35) GENERIC EQUAL; 
EXEC CICS READNEXT DATASET( 'DBTVSQ1' ) INTO( VIG) 


RIDFLD( VICKEY) ; 

/* --- ENDBROWSE TO PERMIT VALID TRANSFORM STARTBROWSE --- */ 
EXEC CICS ENDBR DATASET('DBTVSQ1'); | 
icles sel PASS KEY TO TRANSFORM ---~--- ay 

/* TRANSFORM SELECTION DEPENDENT ON: war 

L* VID. INTYPE ay 

Dis VID.OUTYPE re 

i VID.RECTYP ws 

/* ‘TF THEN GOTO' STRUCTURE INSTEAD OF ~*/ 

/* ‘TF THEN DO ' TO AVOID COMPILER wo; 

/* SYNTAX ERRORS DUE TO TRANSLATOR ee 

he COMMENT AND DO BLOCK 7 

/* --- TRANSFORM 1: X'02', X'0C', ‘A’ */ 

/* 1403 PRINT DATA ===> 1403 DCA L2 ays 


IF ((VID. INTYPE="0000000000001100 ' B) & 
VID.OUTYPE='0000000000000010'B) & 
VID.RECTYP='A')) THEN GOTO TRN1; 
{* --- DEFAULT TRANSFORM : HBTTRNAS 1 ie 
EXEC CICS XCTL PROGRAM OBTTRN1" ) COMMAREA( VIKEY ) LENGTH( 39) ; 
/* --- TRANSFORM TRANSFER LIST --- 
TRNI: EXEC CICS XCTL PROGRAM('DBTTRN1') COMMAREAC VIKEY) LENGTH(39) 
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A.3.9 DBTTRN1. PROGRAM SOURCE 


The DCA initial multibyte controls are constant, independent of the input profile 
information. A subset of the 1403 and ANSI design conversions are made. 


DBTTRN1: PROC(STPOINT) OPTIONS(MAIN); 


IMEI AA A ACM MAEM IM INI Me OI MERE IS He OTIC POSEN TO APR Meare Ie OMe PO Me mm aN WS Reo TR IN Ye Oe Me We WON Ee Oe Ik IN Mees We 


/* x] 
i DBTTRN1: PL1 PROGRAM SOURCE DBTTRN1 FOR TRANSACTION DBTS iy 
/* INPUT: 6000 BYTE KEY SEQUENCED VSAM RECORDS FROM VSQ1 mf 
Vise 1) KEYS WITH USER AND PROCESSING DATA x] 
f= 2) PROFILE DATA ON FIRST AND LAST RECORD if 
/* 3) IRS SEPARATED PRINTLINES ay 
/* OUTPUT: 4088 BYTE KEY SEQUENCED VSAM RECORDS TO VSQ1 */ 
heal 1) KEYS WITH USER AND PROCESSING DATA re 
/* 2) PROFILE DATA ON FIRST AND LAST RECORD aid 
Vs 3) DCA LEVEL 2 DOCUMENT INCLUDING PRESET INITIAL DATA ne 
/* PROCEDURE: ay 
/* 1) THE VSQ1 BLOCKED PRINT LINE MAILBOX REQUEST IS IDENTIFIED x} 
le BY THE START DATA PASSED FROM DBTMST]1 ail & 
/* 2) THE DOCUMENT IS CONVERTED TO A DCA LEVEL 2 DATASTREAM a A 
ts AND IS WRITTEN TO VSQ1 IN UNITS OF A CONVENIENT SIZE we 4 
Vi 33 THE INPUT RECORDS ARE DELETED FROM VSQ1 aay 4 
ee PROGRAM DBTSND1 IS INITIATED WITH FIRST KEY START DATA as 
[arta naan an ane eb erat ehe eiataws oe enuiesa einen 
[Mae esees CONTROL, BLOCK ‘ere Here ane se+ ae -eese- eos s-S ae eae-Ha= aa 


DCL XFPTR POINTER; 
DCL 1 XF ET 
DOCCHAR CHAR(1 
CHFLAGF CHAR(1), 
SEQNO FIXED ea 
DOCIPTR POINTER, 
DOC2PTR POINTER, 
VIPTR POINTER, 
VOPTR POINTER, 
DOCPTR1 FIXED BIN(31 
DOCPTR2 FIXED BIN(31 
1 DOCBIT BIT(8 eee: 
DCL PROREM CHAR(80) ; 
DCL XFLEN FIXED BIN(15); 
DCL KEYLEN FIXED BIN(15) FIXED INIT(39); 
DCL VICREM CHAR(35); 
DCL TDATAREM CHAR( 39) 
DCL SDATAREM CHAR( 35 
[aa WORK AREAS --- BASED FOR DEBUGGING --------------------- */, 
DCL 1 DOCWORK1 BASEDS DOCZPTRS CHARY 40905 VARYING; /*INPUT WORK AREA*/ 
DCL 1 DOCWORK2 BASED(DOCZ2PTR) CHAR( 4090) VARYING; /*OUTPUT WORK AREA*/ 
 ipamirer masa CONTROL: CHARACLER OVERLAYS. See tesesseceererereeesse=Hse= * 


BIT, 
2 NL ane) INI 90001100'8). 


WW WD WD OO & W OG W 


2 FF BIT(8) INIT('00001100'B), 
2 CR BIT(8) INIT('00001101'B), 
1 CHAR BASED(ADDR(BIT)), 

2 NL CHAR(1), 
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2 FF CHARG 1) 
2 CR CHAR(1 
/*-------- Der INITIAL DATA OVERLAYS ------------------------------ “/ 


EAl BIT(48) 
INIT( '001010111101001000000100100001010000000000000000'B) 
SHM1 BIT(32) INIT('00101011110100100000011000010001'B 
SHM2 BIT(32) INIT('00000000000000010010111111010000'B 
SVM1 BIT(32) INIT('00101011110100100000011001001001'B 
SVM2 BIT(32) INIT('00000010110100000011110111100000'B 
SPPS1 BIT(32) INIT( '00101011110100100000011001000000'B 
SPPS2 BIT(32) INIT('00101111110100000011110111100000'B 
SCG1 BIT(32) INIT('00101011110100010000011000000001'B 

SCG2 BIT(32) INIT('00000000110101110000000100001000'B 
1 DCACHAR BASED(ADOR(DCAINI)), 

3 SEA CHAR(6), /* X'2BD204850000' */ 

3 SHM CHAR(8), /* X'2BD2061100012FD0! */ 

3 SVM CHAR(8), /* X'2BD2064902D03DE0! */ 

3 SPPS CHAR(8), /* X'2BD206402FDO3DE0!' */ 

3 SCG CHAR(8): /* X'2BD1060100D70108' 1403 PRINT */ 
/*-------- VSQO/VSQ1 I/O RECORD OVERLAYS -------------------------- */ 
%INCLUDE DBTVSQ; 

DCL (SUBSTR, LENGTH, ADDR ,CSTG ) BUILTIN; 
/*-------- START KEY VARIABLE -----------"------------------------- */ 
DCL STPOINT POINTER, | 
STARTKEY CHAR(39) BASED(STPOINT); 
/*-------- ALLOCATE STORAGE AREAS --------~------------------------- */ 
XFLEN = CSTG(XF); 
EXEC CICS GETMAIN SET(XFPTR) LENGTH(XFLEN) INITIMG('OO000000'B 
EXEC CICS GETMAIN SET vistas LENGTH(6002) INITIMG( '00000000'B 
EXEC CICS GETMAIN SET(DOC2PTR) LENGTH(4090) INITIMG( '00000000'B 
EXEC CICS GETMAIN SET Hh LENGTH(6002) INITIMG( '00000000'B 
EXEC CICS GETMAIN SET(VOPTR) | LENGTH(6002) INITIMG('00000000'B 
VOD.CHFLAGF = '1': 
VOD.CHFLAGL = '0': 
/* THIS IS FOR BUG IN PL1 ONLY, NO CONCATENATE TO NULL STRING */ 
DOCWORK2 = 'Z' 


WO DH WW WD 


w@ we w w ww @ d ww : 


wewewewewe 


/*-------- RETRIEVE START DATA (IF PRIMARY TRANSFORM), -=>>>>>oo== */ 
/*XXXX CICS RETRIEVE INTO(VIG) LENGTH(KEYLEN)*/ 
/*-------- RETRIEVE START DATA (IF SECONDARY TRANSFORM) ----------- */ 


VICKEY = STARTKEY; 

SDATAREM = SUBSTR(VI,1,35); 

EXEC CICS STARTBR DATASET( 'DBTVSQ1') RIDFLD(VICKEY) 

KEYLENGTH(35) GENERIC EQUAL; 
TDOC: /*--------- GET NEXT INPUT RECORD ------- + 
KIKI KKEKKK KKK KKK KKK KKK KKK IKE KKK KK KKK KICK HK KKK KK KKK KKK KKK KKK KKK KKK KKK 
/* CHAINFLAG LAST IS SET BEFORE THE READ, AND RESET AFTER THE READ, */ 
/* SO THAT IF THERE IS NO MORE INPUT DATA, IT IS POSSIBLE TO 
/* BRANCH TO WRITE THE REMAINING OUTPUT DATA, WITHOUT FORGETING ~ */ 
/* THAT THIS IS THE LAST OUTPUT RECORD. a 
[RHR RR ERE KKK KKK KKK KAKI KEK ERE K KK KKK KK KK HK KKK KER KKK KKK KK KKK KKK KKH / 

VOD.CHFLAGL = '1'; 

EXEC CICS HANDLE CONDITION NOTFND(PTDOC) ; 

VICREM = VICKEY; 

EXEC CICS READNEXT DATASET( 'DBTVSQ1') BONES 

RIDFLD( VICKEY) ; 

EXEC CICS HANDLE CONDITION NOTFND; 

IF VICREM ~= VICKEY THEN GOTO PTDOC; 

IF VID.CHFLAGF = '1' THEN PROREM = SUBSTR(VIDATA, 1,80); 

VOD.CHFLAGL = '0'; 
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[%w------- SET INPUT WORK AREA ------------------------------------ */ 
DOCPTR2 = 0; 
DOCWORK1 = VIDATA; 
IF VID.CHFLAGF = 1 | VID.CHFLAGL = 1 THEN 
DOCWORK1 = SUBSTR(VIDATA,81, LENGTH( VIDATA)-80) : 
IF VID.CHFLAGF = '1' THEN 
DOCWORK2 = '1' || SEA || SHM || SVM || SPPS |] SCG; 
FNDPRT: /*--------- FIND NEXT PRINT LINE --------- */- 
IF DOCPTR2 >= LENGTH(DOCWORK1) THEN GOTO GTDOC; 
/* DOCPTR1 GIVES PREVIOUS FOUND IRS, DOCPTR2 GIVES LAST IRS */ 
DOCPTR1 = DOCPTR2; 
DOCPTR2 = DOCPTR2 + 1; 
DO DOCPTR2 = DOCPTR2 TO LENGTH(DOCWORK1); 
DOCCHAR = SUBSTR(DOCWORK1,DOCPTR2,1): 
ata DOCBIT = '00011110'B THEN GOTO IRSFND; /* IRS FOUND */ 
D; 
/*RECORD DID NOT END WITH IRS */ 
DOCPTR2 = DOCPTR2 + 1; 


IRSFND: 
IF (LENGTH(DOCWORK2) + DOCPTR2 - DOCPTR1 + 1) > 4008 THEN DO; 
PTDOC: /*------ WRITE RECORD IF IT IS FULL -----------~- */ 


VOKEY = VICREM || SUBSTR(VOKEY,36,4); /* SET APPROXIMATE KEY */ 
VODATA = SUBSTR(DOCWORK2 , 2, LENGTH(DOCWORK2)-1); 
VOD.INTYPE = '0000000000000010'; /* FF TEXT */ 
[Bass ADD PROFILE DATA IF FIC/LIC/OIC ------------------------ ot 
IF VOD.CHFLAGF = '1' | VOD.CHFLAGL = '1' THEN 
VODATA = PROREM || VODATA; 
SKIPADD: EXEC CICS WRITE DATASET('DBTVSQ1') FROM(VOG) RIDFLD(VOKEY) 
LENGTH(39 + 2 + LENGTH(VODATA)); 
[one ee REMEMBER D072 DATA Seerces sa etee a Coens aa oe a | 
IF VOD.CHFLAGF = '1' THEN TDATAREM = SUBSTR(VO,1,35); 
IF VOD.CHFLAGL = '1' THEN GOTO ENDAT; 
VOD.SEQNO = VOD.SEQNO + 1; 
VOD.CHFLAGF = '0' 
f> Tits. 1S ne BUG IN PL1 ONLY, NO CONCATENATE TO NULL STRING */ 


DOCWORK2 = 
ENDS. 7 \eoea es "MODIEY PRINTLINE ACCORDING TO CARRIAGE CONTROL ---*/ 
OOO IS OO III ISOC IIS I IOI I ICICI I IOI IO IOI I ICO III I III I III AIK 
/* DOCPTR1 POINTS TO PREVIOUS IRS 7 
* 


/* DOCPTR2 POINTS TO NEXT IRS 
J RRREKRKEEKERKER KK RIK KEK KKK RKEK KKK EK KK EK KEK KK KAKKAK KKK KK ERK KERKRAKEKE f 
DOCCHAR = SUBSTR(DOCWORK1 ,DOCPTR1 + 1,1); 
IF DOCPTR2 >= LENGTH(DOCWORK1) 
& VID.CHFLAGL = 1 THEN DO; 
/* DO NOT INSERT DCA CONTROLS AT END OF DOCUMENT */ 
rate * SP] NL */ 
WHEN ('00001011' By. 
DOCWORK2 = DOCWORK2 || CHAR.NL || 
SUBSTR(DOCWORK1,DOCPTR1 + 2,DOCPTR2 - DOCPTR1 - 2); 
WHEN ('00010011'B) DO; 
DOCWORK2 = DOCWORK2 || CHAR.NL || CHAR.NL || 
SUBSTR(DOCWORK1,DOCPTR1 + 2,DOCPTR2 - DOCPTR1 - 2); 


END; 

WHEN (00011011! B) DO; 
DOCWORK2 = DOCWORK2 | CHAR.NL [| CHAR.NL || CHAR.NL || 
SUBSTR(DOCWORK1,DOCPTR1 + 2,DOCPTR2 - DOCPTRI1 - 2); 


END; 
WHEN ('10001011'B) 


DOCWORK2 = DOCWORK2 || CHAR.FF || 
SUBSTR(DOCWORK1,DOCPTR1 + 2,DOCPTR2 - DOCPTRI - 2); 
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WHEN ¢'00000001' B) DO; 
EXEC CICS ENTER TRACEID(2); 
DOCWORK2 = DOCWORK2 || CHAR. 
SUBSTR(DOCWORK1 ,DOCPTR1 + 2 


END: 
WHEN ('00001001'B) DO; 
DOCWORK2 = DOCWORK2 || CHAR.CR || 
SUBSTR(DOCWORK1 ,DOCPTR1 + 2,DOCPTR2 - DOCPTR1 - 2); 


END; 
WHEN ('00010001'B) DO; 
DOCWORK2 = DOCWORK2 || CHAR.CR || 
SUBSTR(DOCWORK] ,DOCPTR + 2,DOCPTR2 - DOCPTR1 - 2); 


END; 7 

WHEN ('00000011'B) GOTO FNDPRT; i* =>: DELETE. “7 
OTHERWISE DOCWORK2 = DOCWORK2 || CHAR.NL || 

SUBSTR( DOCWORK1 , DOCPTR1+2 ,DOCPTR2-DOCPTR1-2) ; 


END; 
DOCWORK2 = DOCWORK2 || CHAR.CR || CHAR.FF; 
/* AT END OF DOCUMENT ADD CR AND FF */ 
GOTO FNDPRT; 


END; 
AMEN ¢ 0000103 f*® SP => NE. */ 
WHEN ('00001011'B) 

ane ore = DOCWORK2 || CHAR.NL [| 

SUBSTR(DOCWORK1 , DOCPTR1 + 2,DOCPTR2 - DOCPTR1 - 2); 
WHEN ('00010011'B) DO; 

DOCWORK2 = DOCWORK2 | CHAR.NL || CHAR.NL | | 
ao ,DOCPTR1 + 2,DOCPTR2 - DOCPTR1 - 2); 
WHEN ('00011011'B) DO; 

DOCWORK2 = DOCWORK2 || CHAR.NL [| CHAR.NL 


CR {| | 2 
,DOCPTR2 - DOCPTR1 - 2); 


a CHAR.NL || SUBSTR(DOCWORK1 ,DOCPTR1 + 2,DOCPTR2 - DOCPTRI1 - 2); 


WHEN (* 10001011 'B) 
DOCWORK2 = DOCWORK2 || CHAR.FF || 
SUBSTR( DOCWORK] , DOCPTR1 + 2,DOCPTR2 - DOCPTR1 - 2); 
WHEN ('00000001'B) DO; 
DOCWORK2 = DOCWORK2 1 CHAR.CR || 
SUBSTR(DOCWORK1,DOCPTR1 + 2,DOCPTR2 - DOCPTR1 - 2); 


END ; 
WHEN ('00001001'B) DO; 
DOCWORK2 = DOCWORK2 || CHAR.CR || 
ened + 2,DOCPTR2 - DOCPTR1 - 2) || CHAR.NL; 


END ; 

WHEN ('00010001'B) DO; 
DOCWORK2 = DOCWORK2 |} CHAR.CR || 
SUBSTR(DOCWORK1,DOCPTR1 + 2,DOCPTR2 - DOCPTR1 - 2) || 
CHAR.NL| | CHAR.NL; 


END ; 

WHEN ('00000011'B) GOTO FNDPRT; hs = DELETE. ~S/ 
OTHERWISE DOCWORK2 = DOCWORK2 || CHAR.NL | | 

SUBSTR( DOCWORK1 , DOCPTR1+2 , DOCPTR2-DOCPTR1-2) ; 


END: 
oe FNDPRT; 
[* wnn-n=- DELETE INPUT RECORDS eee-eneeeereee= */ 
EXEC CICS ENDBR DATASET( 'DBTVSQ1'): 
/* ADD CODING FOR INCOMPLETE DOCUMENTS, NO FIC, NO LIC */ 
EXEC CICS DELETE DATASET('DBTVSQ1' ) 
RIDFLD( SDATAREM) 
KEYLENGTH(35) GENERIC; 
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/*-------- TRANSFER CONTROL TO DBTSND1 ---------------------------- */ 


ate CICS XCTL PROGRAM( 'DBTSND1') COMMAREAC( TDATAREM) LENGTH( 39) ; 


9 
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A.3.10 DBTSND1 PROGRAM SOURCE 


DBTSND1: PROC(COMARPTR) OPTIONS(MAIN) ; 


OOOO III IOC III IO IOI ITI III III III ITI 


/* DBTSNDI: 17 AUGUST 1983 ay 
f* - PLI CICS COMMAND LEVEL TRANSACTION es 
fe - SUBROUTINES CALLED: APIACTIV */ 
ha APIPURGE ay 
c* | APIDIS2 mf 
/* APIFIL2 ts 
i APIPTDOC ai 
he APISUFIX wes 
F* APILAST */ 
/* ALL LINKED INTO MAIN ROUTINE */ 
je - XCTL FROM DBTTRN1 WITH COMMAREA KEY eA 
a ~ INPUT:-KEY ITEM AS COMMAREA */ 
f= -VSAM KEY SEQUENCED RECORDS WITH a7, 
es MAXIMUM RECORDSIZE OF 4088 + 80 + 39 */ 
ig - OUTPUT: L2DCA DATA IS PASSED THROUGH API wed 
he TOGETHER WITH DIA ao 
Va 'REQUEST_DISTRIBUTION' OR as 
is 'FILE' COMMAND, ef 
he AND DOCUMENT PROFILE. */ 
is - RESPONSE TRANSACTION TRIGGERED BY DISOSS we 
/* IS DBTR. é 


WAKA AIA IK AIK LAKE EMR AR A EI RS RRR LN RIM 


DCL (STG,SUBSTR,ADDR,LENGTH,CSTG,UNSPEC) BUILTIN; 


PAIN IRA ACI I Ae NC TEN AAMC A ACHE CE IO IE ISR POE A II eee ef 


/* CONTROL BLOCKS USED BY API ROUTINES +] 
KHRKKK KKK KKK K KK KKK KKK KKK KKK KKK KKK HK KKK KKK KKK KKK KKK KKK 
%INCLUDE _ APICOMP; /* COMMON PLI VERSION */ 
DCL  CBLEN FIXED BIN(15); /* APICOMP LENGTH ~—*/ 
%INCLUDE | APIRETP2; /* RETRIEVE AREA *f 
%INCLUDE  APIDPRP2; /* PROFILE AREA */ 
ICICIO RIO OI IO OC IOC OCI OEIC O IO IO ICI ICI IIR II II IR IR IIR / 
/* INPUT/OUTPUT AREAS FOR DBTVSQ1 £/ 


[RRR KEK KK KK KKK KKK KK KK KKH HK KH KKK KK IK IK IK KICK KKK HK KK / 


DCL VIPTR POINTER; 
DCL VOPTR POINTER; 
YINCLUDE DBIVSQ; 


DCL COMARPTR POINTER; 
DCL 1 COMKEY CHAR(39) BASED(COMARPTR), 
1 COMB BASED(COMARPTR) , 
2 COR CHAR(16), 
1 COMC BASED(COMARPTR), 
2 KEY35 CHAR(35); 


DCL 1 NEXTRANS CHAR(4) INIT('DBTR'); 
DCL DOCPTR POINTER; /* AREA FOR PASSING DCA-L2 DATA */ 
DCL 1 DOCUMENT CHAR( 4088) VARYING BASED(DOCPTR), 
1 DOC2 BASED(DOCPTR), 
2 DOC2FILL CHART 4 /* LENGTH FIELD */ 
2 DOC2L2 CHAR 4088) ; /* MAXIMUM LENGTH 4096 - 8 */ 


DCL 1 SONPARMS, /* PARAM. FOR DIA SIGNON af 
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2 
2 


LNAME Brees 
LPASS BIT(8 
NAME , 


3 NAME1 CHAR( 6 
3 NAME2 BIT(16 
2 PASS, 


3 PASS1 CHAR( 1 


2 OOCTYPE BIT(16) INIT(* 0o00090000000010' ) 
a 00000110! 3), 
INIT('00000001'B / 

a DISTO1'), is 
INIT((2)'00000000'B), . 

* 
ue i) : 
INIT((7)'00000000'B); — /* 


DCL 
DCL 
DCL 


CBLEN = 


3 PASS2 BIT(56 


Z64 BIT(64) INIT((8)'00000000'B) ; 
DIUBUF CHAR(1096) BASED(COMDIUP); 


APTACTIV 
APIRTRVE 
APIRECVE 
APIGTCMD 
APIFIL2 

APIPURGE 
APIDIS2 

APIPTDOC 
APISUFIX 
APILAST 


ENTRY 
ENTRY 
ENTRY 
ENTRY 
ENTRY 
ENTRY 
ENTRY 
ENTRY 
ENTRY 
ENTRY 


EXTERNAL 
EXTERNAL 
EXTERNAL 
EXTERNAL 
EXTERNAL 
EXTERNAL 
EXTERNAL 
EXTERNAL 
EXTERNAL 
EXTERNAL 


CSTG(APICOM) ; 
EXEC CICS GETMAIN SET 
EXEC CICS GETMAIN SET 
EXEC CICS GETMAIN SET 
EXEC CICS GETMAIN SET 
EXEC CICS GETMAIN SET 


COMTRFLG = COMTRYES; 


JOOS OIG GOGO GIOIG GIG OSI ISIC IOI IO IOI I III 


/* ACTIVATE API FOR THIS TRANSACTION 


[EE EAREAAREENER AEA AEE EMEA KE EERE LNA BIN HRN KIN MK 


ATIIN: 


COMDIUPS 
COMDIUP 


OPTIONS 
OPTIONS 
OPTIONS 
OPTIONS 
OPTIONS 
OPTIONS 
OPTIONS 
OPTIONS 
OPTIONS 
OPTIONS 


INTER 
INTER 
INTER 
INTER 
INTER 
INTER 


LENGTH( 4096 
LENGTH( 1096 
DOCPTR) LENGTH(4090) INITIMG('0O000000' 33) 
VIPTR) LENGTH(6004) INITIMG( '00000000'B); 


COMPTR ) “TEneTH( 4086 


CALL APIACTIV(DFHEIBLK,APICOM,NAME, Z64) ; 


EXEC CICS ENTER TRACEID(91); 


IF COMRETCD -= Q THEN GOTO ERROR; 


DISDOC: 


/* NOT USED wd 
LENGTH NAME yA 
LENGTH PASSW. a7, 
USED BY ACTIV. */ 
SIGNON ID ay) 
ey 
NOT USED */ 
PASSWORD = 
wr 
FOR ACTIVATE at 4 
FOR DIA/DCA */, 
CONSTRUCTS Af. 
, /* ACTIVATE 7. 
, /* RETRIEVE ws 
y 7 RECEIVE */ 
, /* GET COMMAND */ 
se DIA MRILE 327 
, /* PURGE ALL a7 
52° DIRS eDIST 7 
;~f. PUT. DOC wd 
7 DEU-SUPELX. 7 
3 f™ API “LASI™ */ 
INITIMG('00000000'B 
INITIMG( '00000000'B 
INITIMG ‘00000000 B 


* 


/* NOW LOOK IF MORE DOCUMENTS ARE PRESENT ON DBTVSQ1 


*/ 
EXEC CICS STARTBR DATASET('DBTVSQ1' ) RE PeeeUMeS) RIDFLD( KEY35) 
GENERIC EQUAL ; 
READ FIRST REC AND CHECK FIC 


NEXTREC. EXEC CICS HANDLE CONDITION ENDFILE(STOP) ; 
EXEC CICS HANDLE CONDITION NOTFND( STOP) 
EXEC CICS READNEXT DATASET('DBTVSQ1') INTO(VI) 


); 

((39) "11111111! B) THEN GOTO NODOC; /* DUMMY RECORD */ 
IF VI3KEY.CHFLAGF -= '1' 

THEN DQ; 
EXEC CICS ENTER TRACEID(1); 


RIDFLD( COMKEY 


IF 


VIDKEY = 


THEN DO. CHFLAGE = 


HEN DQ; 
/* NOW BUILD DIA COMMAND FOR DISTRIBUTE AND CORRECT PARAMETERS */ 
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/* OR FILE DEPENDING ON DISFIL FIELD IN HEADER a ae 


DISTRIB: 
DPRCOR = COMB.COR; /* CORRELATION  */ 
DPRRID = VID.USER; —/* RECEPIENT ADDR*/— 
DPRDDN = VID.OSN; /* DEST. NODE . */ 
DPRSYS = 'IBM DCA- a aaa (/* SYSTEM CODE */ | 
Tpanar a = '9000000000000010'B THEN /* DCA-L2 ? sia 
ELSE GOTO INTYP; /* INVALID INPUT TYPE */ — 
DPRPGC = '00000001010100010000000100000000" B; /* X'01510100' */ 
DPRDON = VI3DATA.DOCNAM; 7* DOC. NAME = */ 
DPRDONL = '00001111'B; /* LENGTH +] 
DPRSUB = ‘MAILBOX PROJECT ee /* SUBJECT as 
DPRSUBL = '00010100'B; /* 20 ef /* LENGTH “7 
DPRAUT = 'MAILBOX  '; /* AUTHOR */ | 
DPRAUTL = '00001010' B: ame Vinay | /* LENGTH © ae A 
/* ACCESS CODE USED FOR FILE, COMMON ACCESS */ 
DPRACC = '0000'; /* ACCESS CODE */ 
DPRACCL = '00000100' Bye a @y /* LENGTH "7 


tf VI3DATA.DISFIL = 'F' 


EN DO; 
yp, CALL APIFIL2(DFHEIBLK, APICOM, APIDPR, DIUBUF) ; 
ELSE DO; 
CALL APIDIS2(DFHEIBLK,APICOM,APIDPR, DIUBUF) ; 


END; 
EXEC CICS ENTER TRACEID(92); 
IF COMRETCD -= 0 THEN GOTO ERROR; 


END; | 

IF VI3KEY.CHFLAGF= '1' /* FOR FIC OR */ | 
| VI3KEY.CHFLAGL= '1' THEN DO; /* LIC ONLY is 
ENDS SUBSTR(VIDATA, 81 * (LENGTH(VIDATA)- 80)); /* DATA */ 
ELSE DO; 


DOCUMENT = SUBSTR(VIDATA, 1, LENGTH(VIDATA) ); /* DCA-L2 DATA */ 


END; 
CBLEN = LENGTH( DOCUMENT ) ; 
/* DOC2L2 IS DCA-L2 DATA WITHOUT LENGTH FIELD */ 
CALL APIPTDOC(DFHEIBLK,APICOM,DOC2L2,CBLEN,APIDPR) ; 
IF COMRETCD == 0 THEN GOTO ERROR; 
IF VI3KEY.CHFLAGL = '1' /* LIC / 
THEN GOTO SEGL; 
GOTO NEXTREC; 
SEGL: 
EXEC CICS ENDBR DATASET('DBTVSQ1'); 


CBLEN = 0; 

/* BUILD DOC. UNIT, SEGMENT LAST */ 
CALL APIPTDOC(DFHEIBLK, aa DOC2L2 ,CBLEN ,APIDPR) ; 
EXEC CICS ENTER TRACEID(93 
IF COMRETCD -= 0 THEN GOTO ERROR; 
EXEC CICS ENTER TRACEID(94); 

/* BUILD DIU SUFFIX af 

CALL APISUFIX(DFHEIBLK, APICOM) 
IF COMRETCD == 0 THEN GOTO ERROR; 
GOTO LAST; 


LAST: 
/* TELL API TO PROCESS “i 
CALL APILAST(DFHEIBLK,APICOM,NEXTRANS) ; 
IF COMRETCD -= O THEN GOTO ERROR; 
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RETURN ; 


TOP: 
EXEC CICS ENDBR DATASET(' DBTVSQ1"); 
EXEC CICS ENTER TRACEID(95); 
DE ni: IN CHAIN FOUND ON DBTVSQ1 FOR A DOCUMENT */ 


NOHEAD: 
/*NO HEADER RECORD FOUND ON DBTVSQ1 FOR A DOCUMENT */ 
Sinn ENTER TRACEID( 96); 


NODOC: 
/*NO MORE DOCUMENTS FOR DISTRIBUTION STOP */ 
SScBNS ENTER TRACEID(97); 


INTYP: | 
/*INVALID INPUT DOCUMENT TYPE a 
RETUR 


Q3BUS: 
/*ANOTHER DBTSND1 IS BUSY GET OUT QUICKLY */ 
RETURN; 


ROR: 
/* PURGE DELETES EVERYTHING ON THE APIQUEUE FOR THIS USER */ 
/* A DIFFERENT WAY OF HANDLING API ERRORS SHOULD BE USED */ 
EXEC CICS ENTER TRACEID(98); 
CALL APIPURGE(DFHEIBLK, APICOM yNAME) ; 
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A.3.11 DBTRSP1 PROGRAM SOURCE 


DBTRSP1: PROC OPTIONS(MAIN); 


ICICI CII III III III IOI II II III IORI II I I III I IIE 


/* DBTRSP1: 17 AUGUST 1983 */ 
/* = PLI CICS COMMAND LEVEL TRANSACTION */ 
/* = SUBROUTINES CALLED: APIRTRVE */ 
7% APIACTIV */ 
/* oy APIGTCMD */ 
/*  APIPURGE */ 
/* APILAST */ 
/* ALL LINKED INTO MAIN ROUTINE * / 
/* = DISOSS API RESPONSE TRANSACTION */ 
/* = INPUT -VSAM KEY SEQUENCED RECORDS WITH x/ 
/* MAXIMUM RECORDSIZE OF 4088 + 80 + 39 */ 
/* ~RETRIEVE DATA OF DISOSS */ 
/* = OUTPUT: NONE x" 


FOR IO OOK IO IOI IOI IO IO kk kk kk KK KK 


DCL (STG,SUBSTR,ADDR,LENGTH,CSTG,UNSPEC) BUILTIN; 


[RRR RKKK KK KKK KHER KE KKK KK KKK KK KKK KEK KK KKK KKKKKER ER / 


/* CONTROL BLOCKS USED BY API ROUTINES */ 
RANK ANA ICK RK MICK AE A RAH ACK AI MAK KIRK MM IHN K, 
%INCLUDE _ APICOMP; /* COMMON PLI VERSION */ 
DCL  CBLEN FIXED BIN(15); /* APICOMP LENGTH —*/ 
%INCLUDE  APIRETP2; /* RETRIEVE AREA ‘ 
%INCLUDE  APIDPRP2: /* PROFILE AREA a] 


ODIO OOOO OOO IOI I III TOC TIO III III 


/* INPUT/OUTPUT AREA FOR DISVSQ1 eee 
J RRRRIARER ER ER EAIEER AAR ERA RERRK KAA EK RKKEAKKRRAREAKRE K ] 
DCL VIPTR POINTER; 
DCL VOPTR POINTER; 
YINCLUDE DBITVSQ; 


DCL DOCPTR POINTER; 
DCL 1 DOCUMENT ene) VARYING BASED(DOCPTR), 
1 DOC2 BASED( DOCPT 


2 DOCZFILL CHAR 2). /* LENGTH FIELD 
2 DOC2L2 CHAR 4088); /* MAXIMUM LENGTH 4096 - 8 
DCL 1 SONPARMS, /* PARAM. FOR DIA SIGNON 


2 DOCTYPE "BIT(16) INIT(’ 0000000000000010" ), /* NOT USED 
2 LNAME BITeBs INET 00000110' BY? * LENGTH NAME 


=. 


2 LPASS BIT(8) INIT('00000001'B /* LENGTH PASSW. 

2 NAME, * USED BY ACTIV. 

3 NAME1 cHARCE) La DISTO1'), /* SIGNON ID 
INIT((2)'00000000'B), /* 


3 NAME2 BIT(16 
2 PASS, * NOT USED 


3 PASS1 CHAR() LHe 1); /* PASSWORD 

3 PASS2 BIT(56) INIT((7)'O0000000'B); /* 
DCL 264 BIT(64) INIT((8)'00000000'B); /* FOR ACTIVATE 
DCL DIUBUF CHAR(1096) BASED(COMDIUP); /* FOR DIA/DCA 


/* CONSTRUCTS 
DCL APIRTRVE ENTRY EXTERNAL OPTIONSC ASM INTERS” /* RETRIEVE 
APIACTIV ENTRY EXTERNAL OPTIONS(ASM INTER), /* ACTIVATE 
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* 


ws 


xy 


*/, 
ay. 
a7 
ny, 
*/ 
y 


mi, 


* 


* 


/ 
/ 


* 
_ 


/* AREA FOR PASSING DCA-L2 DATA */ 


ee 
a 


wa 


*/ 
wd 


APIPURGE ENTRY EXTERNAL OPTIONS(ASM INTER), /* PURGE ALL a 
APILAST ENTRY EXTERNAL OPTIONS(ASM INTER); /* API "LAST" at | 


CBLEN = CSTG(APICOM) ; 

EXEC CICS GETMAIN SET(COMPTR) LENGTH(CBLEN) INITIMG( '00000000'B); 
EXEC CICS GETMAIN SET COMB IUPS TENGTHe 10S¢ INITIMG('00000000'B); 
EXEC CICS GETMAIN SET(COMDIUP) LENGTH(1096) INITIMG( '00000000'B); 
EXEC CICS GETMAIN SET(DOCPTR) LENGTH( 4090) INITIMG( 'O0000000'B) ; 
EXEC CICS GETMAIN SET(VIPTR) LENGTH(6004) INITIMG( '00000000'B); 
COMTRFLG = COMTRYES; 


[ REEENERA LER EERE IK CN IK WRN NICK RMR A AK Rf | 


/* GET DISOSS RETRIEVE DATA as 
J RRERRRRERKER KKK KKK EK KKK KKKKKKEKKK KKK KK KKKKEREKKEKKEK KE / 
CALL APIRTRVE(DFHEIBLK ,APICOM) ; 
IF COMDLEN = 0 THEN GOTO ERROR; 


APIGTCMD ENTRY EXTERNAL OPTIONSC AS INTER) /* GET COMMAND */ 


RESPONSE: 
RETPTR = COMDPTR; 


RDISTR: 
CALL APIACTIV(DFHEIBLK,APICOM,RETNAME,RETTIME); /* ACTIVATE API*/ 
IF COMRETCD -= 0 7HEN GOTO ERROR: 


CALL APIGTCMD( DFHEIBLK,APICOM ,APIDPR); /* RECEIVE DATA*/ 
IF COMRETCD += 0 THEN GOTO ERROR; /* OKAY ? . 
TF COMDCMD -= COMDACK THEN GOTO ERROR; /* ACKNOWLEDGE? */ 


IF DPREXCOD -= (3)'00000000'B THEN GOTO ERROR; /* EXCEPT. CODE*/ 
Ae Prieta DISTRIBUTICN OKAY NOW CLEANUP LAST DISTRIBUTED DOC*/ 


EXEC CICS STARTBR DATASET('DBTVSQ1') RIDFLD(RETDIUID) 
KEYLENGTH(16) GENERIC EQUAL; | 
VIKEY=RETDIUID: 
ae READNEXT DATASET('DBTVSQ1') RIDFLD(VIKEY) 
V 
EXEC CICS ENDBR DATASET( 'DBTVSQ1' ) ; 
EXEC CICS DELETE DATASET( 'DBTVSQ1') RIDFLD(VIKEY) 
eran OD GENERIC; 


3 


ROR: 
3 PURGE DELETES EVERYTHING ON THE APIQUEUE FOR THIS USER */ 
/* A DIFFERENT WAY OF HANDLING API ERRORS SHOULD BE USED */ 
aoe APIPURGE( DFHEIBLK, APICOM, NAME) ; 


bd 
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A.3.12 DBTSONI PROGRAM SOURCE - 


Experience has shown that if distribute or file requests are placed on the API 
queue before this signon program has _ completed, 
requests cause DISOSS transaction DSV1 to fail, 


will also fail. The only 


submit the DISOSS jae tallation job which recreates the API queue. 


DBTSON1: PROC OPTIONS(MAIN); 


[RRREREKK KK KK KEK HIKER KK KK IKKE KKK KKK KK KKKKKKEKKKKKEREKEE 


hs */ 
/* DBTSONI: 17 AUGUST 1983 ws 
{* - PLI CICS COMMAND LEVEL PROGRAM */ 
he - SUBROUTINES CALLED: APIRTRVE */ 
je APIACTIV gis 
/* APISGNON */ 
f* APILAST a7. 
hi APIPURGE ad 
bi APTRECVE ws 
[® APIGTCMD al A 
{* - INPUT RETRIEVE DATA FROM DISOSS ies 
/* - SIGNON COMMAND TO DISOSS ws 


HHKKK KKH KKK KKK KKK IIH HK KK KKK KKK KKK KKK KKH IKIK KKK KKK KHER KKK | 


“INCLUDE APICOMP; 
“INCLUDE APIRETP; 
“INCLUDE APIDPRP; 


DCL (ADDR,LENGTH,CSTG,UNSPEC) BUILTIN; 
DCL CBLEN FIXED BIN(15); 


DCL 1 SONPARMS, 


2 DOCTYPE "BIT(16) INTT() 0000000000000010'), 
2 LNAME BIT(8} INET 00000110! 1B 


2 LPASS BIT(8 
2 NAME, 
3 NAME1 BITC te’ 
3 NAME2 BIT(16 
2 PASS, — 


3 PASS1 eat 
3 PASS2 BIT(56 


INIT 


'00000001'B 


INIT('DISTO1' 
INIT 


NETS 1 
INIT 


DCL DIUBUF CHAR( 4096) BASED( COMDIUP) ; 
DCL 264 BIT(64) INIT((8)'00000000'B); 


DCL APISGNON ENTRY 
APIRTRVE ENTRY 
APTACTIV ENTRY 
APITRECVE ENTRY 
APIGTCMD ENTRY 
APIPURGE ENTRY 
APILAST ENTRY 


EXTERNAL OPTIONS(ASM 
EXTERNAL OPTIONS( ASM 
EXTERNAL OPTIONS( ASM 
EXTERNAL OPTIONS(ASM 
EXTERNAL OPTIONS( ASM 
EXTERNAL OPTIONS( ASM 
EXTERNAL OPTIONS( ASM 


CBLEN = CSTG(APICOM) ; 
EXEC CICS GETMAIN SET(COMPTR) sai aaa INITIMG( ‘00000000 'B) ; 


(2)* 90000000" 'B), 


(7)* Go000000' 'B); 


INTER), /* SIGNON a 
INTER), /* RETRIEVE ww A 
INTER), /* ACTIVATE ws 
INTER), /* RECEIVE a a 
INTER), /* GET COMMAND */ 
INTER), /* PURGE ALL */ 
INTER) ; 


/* API "LAST" y: 
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then not only will those 
but any subsequent signons 
obvious course of action under these circumstances is to 


EXEC CICS GETMAIN SETeCOMBTUP LENGTH? 40968 INITIMG 
INITIMG 


EXEC CICS GETMAIN SET 
COMTRFLG = COMTRYES; 


CALL APIRTRVE(DFHEIBLK,APICOM) ; 


COMDIUP) LENGTH( 4096 


IF COMDLEN -= 0 THEN GOTO RESPONSE; 


SIGNON: 


CALL APIACTIV(DFHEIBLK ,APICOM,NAME, Z64) ; 

IF COMRETCD -= 0 THEN GOTO ERROR; 

CALL APISGNON( DFHEIBLK,APICOM, DIUBUF , SONPARMS ) ; 
IF COMRETCD -= 0 THEN GOTO ERROR; 

GOTO LAST; 


CALL APILAST(DFHEIBLK ,APICOM, EIBTRNID); 
na ot aa -= 0 THEN GOTO ERROR; 


RESPONSE: 


RETPTR = COMDPTR; 

se ENC OI’) Gore 
WHEN('01') GOTO RSGNON; 

ae GOTO ERROR; 


RSGNON: 


CALL APIACTIV(DFHEIBLK ,APICOM,RETNAME ,RETTIME) ; 
IF COMRETCD -= 0 THEN GOTO ERROR; 

CALL APIGTCMD(DFHEIBLK,APICOM ,APIDPR); 

IF COMRETCD -= 0 THEN GOTO ERROR; 

IF COMDCMD -~= COMDSON THEN GOTO ERROR; 

Sa a START TRANSID('DBTM'); 


ROR: 
CALL APIPURGE(DFHEIBLK,APICOM,NAME); 
END; 
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: 


00000000'B 
'00000000'B 
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A.3.13 DBTCLN1 PROGRAM SOURCE 


DBTCLN1: PROC OPTIONS(MAIN REENTRANT); 


SECIS TIO IIIT IIIT OTTO T I ITT ATI T III IO 


x */ 
/* DBTCLN1: DELETES ALL RECORDS ON VSQO AND VSQ1 of 
/* AND PUTS ONE DUMMY RECORD ON EACH. ay 


JIGS ISI IOI II III III III IIIT III IAI III III III III] 


DCL (LENGTH,STG,CSTG,ADDR eR BUILTIN; 
“INCLUDE DBTVSQ; /*VSQO AND VSQ1 my 
“INCLUDE DBTOC; /*OPENBLK FOR OPEN/CLOSE MACRO */ ee 
EXEC CICS GETMAIN SET AO LPTRS ENGTHY 122 INITIMG(' 00000000! B), 
EXEC CICS GETMAIN SET(QOQIPTR) LENGTH(125) INITIMG( | 00000000 B); 
EXEC CICS GETMAIN SET(VIPTR) LENGTH( 6002) INITIMG( 00000000! B); 
| igre mas MASS DELETE VSQ1 ENTRIES ec ee ad 
EXEC CICS STARTBR DATASET('DBTVSQ1') RIDFLD(VICKEY) GENERIC 
KEYLENGTH(0) ; 
EXEC CICS HANDLE CONDITION ENDFILE(VSQ1EN) ; 


VSQ1: 
EXEC CICS READNEXT DATASET( ' DBTVSQ1' ) sara INTO(VI); 
IF VIDKEY = ((39)' 1itiiil B) THEN GOTO VSQ1 
EXEC CICS DELETE DATASET( 'DBTVSQ1' ) RIDFLDCVICKEY) 
KEYLENGTH(35) GENERIC; 
GOTO VSQ1; 
VSQIEN: 


Q1E 
VIDKEY = (39)'11111111'B 
EXEC CICS WRITE DATASET(! ' DBTVSQI' ) FROM(VI) 
RIDFLD(VIKEY) LENGTH(39); 
VSQIEND: 
EXEC CICS ENDBR DATASET( 'DBTVSQ1'); 
[kn-------- MASS DELETE VSQO ENTRIES --~------- xf 
DBNAME = 'DBTVSQO '; 
RC = '11111111'B; 
FCT = (3 11111111'B: 
FFF = (3)'11111111'B: 
EXEC CICS LINK PROGRAM( ' DBTOPN1' ) COMMAREA(OPENBLK) LENGTH(15): 
IF RC -= '00000000'B THEN GOTO STOP; 
EXEC CICS STARTBR DATASET('DBTVSQO') RIDFLD(VICKEY) GENERIC 
KEYLENGTH(0): 
eRe CICS HANDLE CONDITION NOTFND(VSQOEN); 
EXEC CICS READNEXT DATASET( ' DBTVSQO' ) RIDFLD( VICKEY) INTOCVI): 
IF VIDKEY = ((39)'11111111'B) THEN GOTO VSQOEN 
EXEC CICS DELETE DATASET( 'DBTVSQO' ) RIDFLD(VICKEY) 
KEYLENGTH(35) GENERIC: 
GOTO VSQo; 
VSQOEN: 
VIDKEY = (39)'11111111'B 
EXEC CICS WRITE DATASET(! ' DBTVSQO' ) FROM(VI) 
RIDFLD(VIKEY) LENGTH(39): 
VSQOEND: 
EXEC CICS ENDBR DATASET( 'DBTVSQO' ); 


EXEC CICS LINK PROGRAM( | ee ce COMAREA( OPENBLK) LENGTH(15); 
IF RC -= '00000000'B THEN GOTO ERR3; 

ERR3: GOTO LAST; | fis OPEN/CLOSE ERROR */ 

LAST: END; 
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A.3.14 DBTSOF1 PROGRAM SOURCE 


Since a DIA Sign_Off is rarely required, the DBTSOF1 program is unlikely to be 
needed, and is not used in our system. 


DBTSOF1: PROC OPTIONS(MAIN); 


[J RRRRRREREREEKKKRKRKKKEKK KEE KKK K KEKE KKK KEKE KRKEKKKKKKK Kf 


* Ws 
/* DDBSOF1: 17 AUGUST 1983 ay 

- PLI CICS COMMAND LEVEL PROGRAM */ 
he - SUBROUTINES CALLED: APIRTRVE */ 
i APIACTIV of 
j* APISNOFF ef 
ie APILAST */ 
/* APIPURGE wr 
/* APTRECVE aid 
/* APTGTCMD ay 
ae ~ INPUT RETRIEVE DATA FROM DISOSS my 
/* - SIGNOFF COMMAND TO DISOSS [ 


f AAAI IN TT Ie A eR Te Me MLC eS We MMAR ROME, WON Ie MN WE HIN HHO 7 


“INCLUDE APICOMP; 
“INCLUDE APIRETP; 
“INCLUDE  APIDPRP; 
DCL (ADDR,LENGTH,CSTG,UNSPEC) BUILTIN; 
DCL CBLEN FIXED BIN(15); 
DCL 1 SONPARMS, 
2 DOCTYPE BIT(16) INIT('0000000000000110'), 
2 LNAME BIT 8 INET? 'OODO001' BS” 
2 LPASS BIT(8) INIT('00000001'B 
2 NAME 


3 NAME1 CHAR( aed 
73 NAMEZ BIT(16) INIT((2)'00000000'B), 


3 PASS1 CHAR() LTE RE 
3 PASS2 BIT(56) INIT((7)'G0000000'B): 


DCL DIUBUF CHAR(4096) BASED(COMDIUP) ; 
DCL 264 BIT(64) INIT((8)'00000000'B); 


3 


DCL APISNOFF ENTRY EXTERNAL OPTIONS(ASM INTER * SIGNOFF = 
APIRTRVE ENTRY EXTERNAL OPTIONS(ASM INTER), /* RETRIEVE a A 
APIACTIV ENTRY EXTERNAL OPTIONS(ASM INTER * ACTIVATE ey, 
APIRECVE ENTRY EXTERNAL OPTIONS(ASM INTER), /* RECEIVE */ 


APIGTCMD ENTRY EXTERNAL OPTIONS(ASM INTER 
APIPURGE ENTRY EXTERNAL OPTIONS(ASM INTER 
APILAST ENTRY EXTERNAL OPTIONS(ASM INTER); 


CBLEN = CSTG(APICOM) ; 

EXEC CICS GETMAIN SET(COMPTR) LENGTH(CBLEN) INITIMG( '00000000'B); 
EXEC CICS GETMAIN SET COMDIUPS TENGTH? 4096 INITIMG('OO000000'B 
EXEC CICS GETMAIN SET(COMDIUP) LENGTH( 4096) INITIMG( '00000000'B 
COMTRFLG = COMTRYES; 


/* GET COMMAND */ 
/* PURGE ALL “/. 
/* APT "LAST" oF 4 


wew wwe wewae 6] 


e 
> 
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CALL APIRTRVE(DFHEIBLK,APICOM) ; 
TF COMDLEN -= 0 THEN GOTO RESPONSE; 


SIGOFF: 
CALL APIACTIV(DFHEIBLK,APICOM,NAME ,Z64); 
EXEC CICS ENTER TRACEID(3); 
IF COMRETCD -= 0 THEN GOTO ERROR; 
EXEC CICS ENTER TRACEID(4); 
CALL APISNOFF(DFHEIBLK, APICOM) ; 
EXEC CICS ENTER TRACEID(5); 
IF COMRETCD -= 0 THEN GOTO ERROR; 
GOTO LAST; — 


LAST: 
CALL APILAST(DFHEIBLK ,APICOM, EIBTRNID) ; 
EXEC CICS ENTER TRACEID(3); 
IF COMRETCD -= 0 THEN GOTO ERROR; 
EXEC CICS ENTER TRACEID(4); 
RETURN; 


RESPONSE: 
RETPTR = COMDPTR; 
SE MENC 61"). @ure 
WHEN('O1') GOTO RSGOFF; 
OTHERWISE GOTO ERROR; 


RSGOFF: 
CALL APIACTIV(DFHEIBLK,APICOM,RETNAME,RETTIME);_ 
IF COMRETCD ~= 0 THEN GOTO ERROR; 
CALL APIGTCMD(DFHEIBLK,APICOM ,APIDPR); 


IF COMRETCD -= 0 THEN GOTO ERROR; 
RETURN; 


ERROR: 
CALL APIPURGE(DFHEIBLK,APICOM, NAME) ; 


END; 
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A.3.15 DBTTRTOl TRANSLATE TABLE 


This job generates a special translate table to be added to the DISOSS system. 
DISOSS will use this table to translate documents from Codepage 264 (1403 TN) 
to GCID 337-256 (the Multi-Lingual Codepage), for delivery to subsystems (in- 


cluding DISOSS/PS and Displaywriter) which do not support Codepage 264. 


//WTCR7A JOB (0-863201) ,WRIGHT ,MSGLEVEL=(1,1) ,MSGCLASS=A, 
// CLASS=A , REGION=1024K , NOTIFY=WTCR7 

/*ROUTE PRINT RALYDPD3.WTCR7 

/*ROUTE XEQ RALVSMV8 


J [RERRRRRERE KERRIER ER KKK EE KKK KEKE KK IK KKK EK KEKE KEK KKK KKK KKK KKK KEKE EEK 


//* DISOSS V3 INSTALLATION ASSIST * 
ve TRANSLATE/PRINT FIDELITY TABLE * 

* 
//* THIS JOB ASSEMBLES AND LINK-EDITS TRANSLATE/PRINT FIDELITY . 
//* TABLE DBTTRIO1 m 
//* . 
//* LIBRARY - DISOSS30.DSVLOAD a: 
//* MEMBER - DBTTRTO] * 
//* | * 
//* NOTE: REFER TO COMMENTS IN SOURCE CODE FOR PRINT FIDELITY TABLE * 
hie REGARDING OUTSTANDING DISOSS PROBLEM AS AT JAN 24 1984 ‘ 

* 


HHKKIKIK KKK KKK KI KKK IK HK KKK IK KKK IKK KKK KIKI KKK KKK KKK KKK KKKKKKKKK KKK KK 


//XLATE PROC 

//EXASM EXEC PGM=IFOX00 ,PARM='OBJ,NODECK' 

//SYSLIB DD DSN=SYS1.MACLIB,DISP=SHR 

// DD DSN=DISOSS30.ADSVMAC , DISP=SHR 

//SYSPRINT DD SYSOUT=A 

//SYSPUNCH DD DUMMY 

//SYSUT1 ODD UNIT=SYSDA,SPACE=(1700, (600,100): 

//SYSUT2 DD UNIT=SYSDA, SPACE=(1700, (600,100 

//SYSUT3 DD UNIT=SYSDA,SPACE=(1700 , (600,100 

//SYSGO DD UNIT=SYSDA, SPACE=( 80, (500,50) ) ,DISP=( ,PASS) , DSN=&&0BJ 
//SYSIN DD DDNAME=DSVIN 

//LKED EXEC PGM=IEWL, 

/ PARM='NCAL ,MAP , LET, XREF,SIZE=( 500K, 100K)' , REGION=130K 
//SYSPRINT DD SYSOUT=A 

//SYSUDUMP DD SYSOUT=A 

//SYSLIB DD DSN=DISOSS30.DSVLOAD,DISP=SHR 

//SYSLIN DD DSN=&&0BJ , DISP=(OLD, DELETE) 

//SYSLMOD DD DSN=DISOSS30.DSVLOAD(&MBR) , DISP=SHR 

Geen ea 


//EXECPROC EXEC XLATE,MBR=DBTTRTO1 
//DSVIN DD * 


KHKKKEKKKHKKKKKKKKKKKKKKKHEKKKKKKKKKKK KK IK KR KKK Ok kk KKK kK KK KKK 
* 


* $MOD(DBTTRTO1) COMP(ST) PROD(DISOSS): 

: DESCRIPTIVE NAME: TRANSLATION/PRINT FIDELITY TABLE 
* COPYRIGHT: 5665-290 COPYRIGHT IBM CORP 1983 

: LICENSED MATERIAL - PROGRAM PROPERTY OF IBM 
x 

* 


REFER TO COPYRIGHT INSTRUCTIONS FORM 
NUMBER G120-2083 


Sample System Components 


99 


STATUS: VERSION 3 RELEASE 1 


FUNCTION: THIS MODULE IS THE TRANSLATE / PRINT FIDELITY 
TABLE THAT ALLOWS TRANSLATION 
FROM XXXXX-00264 INTE TN PRINT TRAIN) 
TO 00337-00256 (INTERNATIONAL MULTILINGUAL) 


ES: 

DEPENDENCIES: NONE 
RESTRICTIONS: NONE 
REGISTER CONVENTIONS: NONE 


INPUT: N/A 

OUTPUT: N/A 

EXIT CONDITIONS: N/A 

EXTERNAL REFERENCES: 
ROUTINES: NONE 


DATA AREAS: 
REFERENCED: NONE 
MODIFIED: NONE 


CONTROL BLOCKS: 
REFERENCED: NONE 


MODIFIED: NONE 
TABLES: N/A 


MACROS: 
INTERNAL: NONE 
EXTERNAL: NONE 


CHANGE ACTIVITY: 

$LO=ST HDO3102 052682 846301: DR-G 

$P1=MPFO0956 HDO3102 090282 846301: OUTGCID COMMENT WRONG 
$D1=BECST900 HDO3102 120682 846301: CHANGE TO VERSION 2 TABLE 
$P2=MPSO0022 HDO3102 120682 846301: SAME AS $D1 (B@@ST900) 
$P3=MPSO009 HDO3102 121382 846301: CORRECT XREF PROBLEM 

* —$P4=MPS0270 HDO3102 021083 846301: CHANGE TO REGISTERED GGID 


KKKKKKIKKKKKKKKKK KKK KKK KKK KKK KK KKK KK KK KKK KKK KKK KKKKKKKKKRKKKKKEKKKKKK 


*e € ee He HEHEHeH HH HHH HEHEHE HEH HEHEHE KE HHH HEHEHE HEHEHE KE HE HHH HE HH KE KE HK ON 


DBTTRTO1 CSECT IN DSVXIDX TBLID=DBTTRTO1 
DC ACSC OOa37- | INGP ID=00264 | 
DC AL2(00337,00256) OUTGCID=00337-00256 /*@P1C (@P4C*/ 
DSVS6TRN DS OXL256 THE TRANSLATION TABLE | | 
DC _ X'000102030405060708090A0BOCODOEOF! /* 00 - OF */ 
DC X'101112131415161718191A1B1C1IDIE1F! /* 10 - 1F */ 
DC = =—s- X'202122232425262728292A2B2C2D2E2F' /* 20 - 2F */ 
DC X'303132333435363738393A3B3C3D3E3F' /* 30 - 3F */ 


* 


MAP CENT rH TO CENT : BO 
* MAP a a BAR 4F) TO VERTICAL BAR 


BB 
X'40414243444546474849B04B4C4D4EBB' =/*40 - 4F*//*@D1C*/ 


* MAP EXCLAMATION 9A) TO EXCLAMATION 4F 
* MAP LOGICAL NOT oF) TO LOGICAL NOT BA 
DC X'505152535455565758594F5B5C5D5EBA' 9 /*50 - 5F*//*@D1C*/ 


DC X'606162636465666768696A6B6CE6D6E6F! /*60 - 6F*//*@D1C*/ 
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: 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 


DC a EL TTI Th /*70 - 7F*//*@D1C*/ 
C 


MAP LEFT BRACE 8B) TO LEFT BRACE 

MAP LESS OR EQUAL 8C) TO LEFT CHEVRON 8A 

MAP LEFT PAREN 8D) TO LEFT PAREN 4D 

MAP PLUS 8E) TO PLUS 4E 
DC X'808182838485868788898ACO8A4D4E8F' /*80 - 8F*//*@D1C*/ 

MAP RIGHT BRACE 9B) TO RIGHT BRACE DO 

MAP HOLLOW SQUARE 9C) TO LOZENGE oF 

MAP RIGHT PAREN 9D) TO RIGHT PAREN 5D 

MAP PLUS OR MINUS 9E) TO PLUS OR MINUS 8F 

MAP FILLED SQUARE 9F) TO LOZENGE 9F 
DC X'909192939495969798999AD09F5D8F9F' /*90 - 9F*//*@D1C*/ 

MAP HORIZONTAL BAR (AQ) TO MINUS 6D 

MAP DEGREE Al) TO DEGREE 90 

MAP BOX CNR-LWR LEFT(AB}) TO PERIOD 4B 

MAP BOX CNR-UPR LEFT(AC) TO PERIOD 4B 

MAP LEFT BRACKET AD) TO LEFT BRACKET 4A 

MAP GREATER OR EQUAL(AE) TO RIGHT CHEVRON 8B 
DC X' 6BD9DAZA3A4A5A6A7A8ASAA4SB4B4A8BAF! = /*AO - AF*//*@D1C*/ 

MAP SUBSCRIPTS 0-9 (BO-9) TO NUMERICS 0-9 (FO-9) 

MAP BOX CNR-LWR RGHT(BB) TO PERIOD 4B 

MAP BOX CNR-UPR RGHT(BC) TO PERIOD 4B 

MAP RIGHT BRACKET BD) TO RIGHT BRACKET 5A 

MAP NOT EQUAL BE) TO HASH 7B 

MAP LONG UNDERSCORE (BF) TO UNDERSCORE 6D 
DC X'FOFLF2F3F4F5F6F7F8F9BA4B4B5A6F6D' /*BO - BF*//*@D1C*/ 
DC X'COCIC2C3C4C5CEC7C8C9CACBCCCDCECF' § /*CO - CF*//*@D1C*/ 
DC X'DOD1D2D3D4D5D6D7D8D9DADBDCDDDEDF' /*DO - DF*//*@D1C*/ 
DC X'EQEIEZE3E4E5E6E7E8EQ9EAEBECEDEEEF' /*EQ - EF*//*@D1C*/ 
ane X'FOFLF2F3F4F5F6F7F8F9FAFBFCFDFEFF' /*FO - FF*//*@D1C*/ 

SVS6PFC DS OXL256 THE PRINT FIDELITY TABLE 


X'00' - PRINT FIDELITY MAINTAINED 
X'04' = PRINT FIDELITY COMPROMISED 


NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE 


THERE IS A DISOSS PROBLEM OUTSTANDING AT THE DATE OF THE LATEST 
REVISION OF THIS TABLE (JAN 24 1984). IF THE TABLE INDICATES 

THAT PRINT FIDELITY HAS BEEN COMPROMISED, DISOSS WILL DELIVER A 
GARBAGE DOCUMENT TO DISOSS/PS. DISOSS/PS WILL SHOW AN ENTRY IN THE 
MAIL LOG, BUT WHEN THE DOCUMENT IS DISPLAYED NOTHING WILL APPEAR IN 
THE AREA OF THE SCREEN WHERE THE TEXT SHOULD BE. 

IF THE PROBLEM HAS BEEN FIXED BY THE TIME YOU INSTALL THIS TABLE, 
YOU SHOULD DETERMINE WHICH OF THE TRANSLATIONS IN THE ABOVE TABLE 
CAUSE A LOSS OF PRINT FIDELITY, AND MODIFY THE FOLLOWING TABLE 
ACCORDINGLY. TO DO THIS, ENTER X'04' IN THE POSITION IN THE TABLE 
WHICH CORRESPONDS TO THE HEX VALUE OF THE INPUT CHARACTER THAT 
TRANSLATES TO A DIFFERENT SYMBOL ON OUTPUT. FOR EXAMPLE, THE LOWER 
LEFT BOX CORNER CHARACTER (X'AB') HAS NO EQUIVALENT IN THE OUTPUT 
GCID AND WE HAVE CHOSEN TO TRANSLATE IT TO X'4B' WHICH IS A PERIOD 
(FULL STOP) ON THE MULTILINGUAL CODE PAGE. THEREFORE A VALUE OF 
X'04' SHOULD BE PLACED IN THE TWELFTH ENTRY OF THE ELEVENTH LINE 
OF THE TABLE THUS: 


DC X' Oooood0o0NROOONOONNONON400000000' /*AD - AF*//*@D1C*/ 
NOTE HOWEVER THAT NOT ALL OF THE ENTRIES IN THE TRANSLATE TABLE 
WHICH ALTER THE HEX VALUE OF THE OUTPUT CHARACTER CAUSE A LOSS OF 
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€ 4 & € € 


/* 
// 
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FIDELITY. FOR EXAMPLE, A CENT SYMBOL IS X'4A' ON THE INPUT. THIS 


TRANSLATES TO X'BO' ON OUTPUT. X'BO' IN THE MULTILINGUAL CODE 


PAGE IS A CENT SYMBOL, SO THE INPUT AND OUTPUT SYMBOLS ARE THE 
SAME. THE INPUT VALUES WHICH TRANSLATE TO A DIFFERENT SYMBOL USING 


X'00000000000000000000000000000000! 
X'Q0000000000000000000000000000000'! 
X'Q0000000000000000000000000000000! 


— X'90000000000000000000000000000000' 


X'Q0000000000000000000000000000000' 
X'Q0000000000000000000000000000000' 
X'Q0000000000000000000000000000000' 
X'Q0000000000000000000000000000000' 
X'00000000000000000000000000000000' 
X'Q0000000000000000000000000000000' 
X'00000000000000000000000000000000' 
X'00000000000000000000000000000000' 
X'00000000000000000000000000000000' 
X'¢0000000000000000000000000000000' 
X'00000000000000000000000000000000' 
X'Q0000000000000000000000000000000' 
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THE ABOVE TABLE ARE 8C,9C,9F,A0,AB,AC,AE,B0-B9,BB,BC,BE,AND BF. 


/* 00 - OF */ 
/* 10 - 1F */ 
/* 20 - 2F */ 
/* 30 - 3F */ 
/* 40 - 4F */ 


f° 50S SF" 77200107 
/*60 - 6F*//*@D1C*/ 
/*70 - 7E*//*@D1C*/ 


/*80 - 8F*//*@D1C*/ 
/*90 - 9F*//*@D1C*/ 
/*AQ - AE*//*@D1C*/ 
/*BO - BF*//*@D1C*/ 
Z*CO'= CE*//*@D1C*7 
/*DO0 - DF*//*@D1C*/ 
/*EO - EF*//*@D1C*/ 
JECO OPES 7 f° CDIC*/ 


A.4. IMPROVEMENTS AND ALTERNATIVES 


This section is a list of ideas for programming improvements and alternative 
options. 


¢ DBTBAT1 performs the entire construction of its output 80-byte header. On 
reflection, it would probably be better for it to copy the input header into 
the output header, modifying only those fields concerning DBTBAT1 direct- 
ly. The philosophy of this is to increase efficiency, to minimise the proc- 
essing of fields which pass through a program without being used or 
modified, and to decrease the likely number of changes should the meaning 
of an area be altered. 


¢ More analysis could be made of the responses from the OPEN/CLOSE in the 
program DBTMOV1, and the response from DISOSS to the programs 
DBTSON1, DBTSOF1, DBTCLNI, and DBTSND1. Errors could be identified 
instead of just detected. 


Most of the above CICS programs issue an API queue PURGE command upon 
error detection. This deletes all API requests associated with the issuing 
user. This is safe for the DISOSS system, but somewhat drastic for the 
user, especially since currently the mailbox API requests are all issued in 
the name of the same user. Some errors may not require the purge. 


e The initial data inserted into the DCA datastream by DBTTRN1 from struc- 
ture DCAINI could be modified according to input profile information such 
as the pagelength and pagewidth. DBTTRNI1 could also be made to deduce 
information about the document. Some deduced information might only be 
available to the program after the body of the document has been proc- 
essed. For example the pagelength or pagewidth might be specified by the 
user as undefined, causing DBTTRN1 to keep a tally on the largest output 
lines as they are created. Such information would then have to be written to 
the profile area in the first and last output-records using a READ UPDATE. 


¢ Some users may wish to turn the facility on and off. The facility can be 
turned on, but it cannot be safely turned off, because irreversible damage 
appears to be done to the API queue by a Request_Distribution without a 
preceding Sign_On. Perhaps the simplest way to switch the system off 
would be to use CEMT to disable transaction DBTM. 


A.5 SIMULTANEOUS CICS/BATCH ACCESS TO SHARED DATASET 


A CICS attempt to open dataset DBTVSQO during batch access caused DBTM to 
stop, and reinitiate itself, as intended, and allowed the batch job to continue 
normal execution. | 


A batch attempt to open dataset DBTVSQO during CICS access did not terminate 
the job, allowed DBTM to continue normal execution, and caused |EC161 052-084 
data management messages to be displayed on the MVS operator console until 
CICS relinquished control. In a production environment, it would be worth 
warning the operators that these messages are expected and normal. 
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B.O API AND DIU-BUILD SUBROUTINES 


The DiU-building and API interface utilities were written by Martin Hibbert of 
IBM UK Technical Support, and are documented in DISOSS Application Inter- 
face: Programming Guidelines, GG24-1614. A few of them have been modified for 
use in our system; these are identified by names ending in ‘2', e.g. APIDPR2, 


APIDPRP2, APIRETP2, APIDIS2, APIFIL2, APIDIUS2. 


B.1 ASSEMBLER CONTROL BLOCKS 


B.1.1 APICOM 


DISOSS API program common area 


KKK KKK KI KKK KKK KKK IK KKK KK KK KKK KK KKK IKK HK KK IKK KKK KKK KK KKK KKK KI KH KKK HK KK KK 


COMDBUFP DS 
COMLDIU1 DS 
COMLDIU2 DS 
COMLDIU3 DS 
COMLDIU4 DS 
COMDCMD DS 


INTERNAL DIU BUFFER POINTER 
TOTAL DIU DATA LEGTH 

TOTAL DIU SEGMENT LENGTH 
AMOUNT OF SEGMENT USED SO FAR 


WHAT COMMAND IS BEING SENT 


* APICOM : DISOSS API PROGRAM COMMON AREA * 
KKIKKKK KKK IKI KKK KKK KKK KKK IK HICK IK IK KIKI KH KKK IKK KK KK KKK KKK KK KKK KKK KK KK KKK 
SPACE 
APICOM DSECT 
SPACE 
COMXN DC  CL8'*APICOM*! EYE CATCHER NAME 
COMXC DC  CL8'COMMAND! & CURRENT COMMAND 
COMMT DC CLAYTRAN' & TRANSACTION ID 
COMPARMS DS OF STANDARD PARM LIST: 
COMP! DS A 
COMP2 DS A 
COMP3 DS A 
COMP4 DS A 
COMPS «=6siéDS”tsiCAA 
COMP6 =6DS) OA 
COMP7 DS A 
SPACE 
COMCPTR DS A POINTER TO CONTROL BLOCK 
COMRETCD DSF RETURN CODE 
COMREASN DSF REASON CODE 
COMDPTR DS A POINTER TO COMMAND DATA 
COMDLEN DS 4H DATA LENGTH 
COMSPAR1 DSH SPARE 
SPACE 
COMDPRP DS A DOC PROFILE POINTER 
COMDIUP DS A OUTPUT DIU POINTER 
SPACE 
A 
H 
H 
H 
COMDDLV EQU  X'O1! THIS IS DELIVER COMMAND 

COMDACK EQU  X'02! _ THIS IS ACK 

COMDSON EQU  X'03! THIS IS SIGNON RESPONSE 


APl ane Divebuild Subroutines 


105 


COMDST DS B STATUS FLAGS WITHIN DIU ANALYSIS 
COMDSTC EQU- X'Ol1' COMMAND + OPERANDS ANALYSED 
COMDSTP EQU- X'02' DOCUMENT PROFILE ANALYSED 
COMDSTD EQU- X'04! DOCUMENT TEXT BUFFER FULL 
COMDSTX EQU X'40' HAVE REACHED SUFFIX 
COMDSTE EQU X'80! HAVE REACHED END OF DATA — 

C 


COMTRFLG DS DO EXTRA TRACE CALLS IF "T" 
COMTRYES EQU C'T' | | 


CoN aes 16F SAVE AREA WHEN DOING TRACE 
COMLEN EQU *-APICOM LENGTH OF API COMMON AREA 
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B.1.2 APIDPR2 


This is a modification of the original APIDPR. 


FORO FOO IORI III OO IO IO IO ROR III III OI OI OR IOI IO IO II ICICI 


* AREA FOR COMMAND PARAMETERS AND DOCUMENT PROFILE a 

FORK KI KKK IKK II KKK KK KKK KK KIKI IKK KKK KKK KKK IK KKK KKK KKKKKKKKKKKKKK 
SPACE 

APIDPR DSECT 

DPR DS OF 


SPACE 
* FOLLOWING ARE RESERVED FOR COMPATIBILITY WITH TEXT 4K BLOCKS 
DPRRESV EQU * 
DS H 
DS H 


DS F 

DPRRESVL EQU = *-DPRRESV 
SPACE 

. ne ae ge SECTION. 


DPRCMD 
SPACE 

* 'DELIVER' COMMAND 

DPRSID DS CL8 SOURCE ID 

DPRRID DS CL8 RECIPIENT ID 

DPRDDN ODS CL8 DDN (LOCATION) 

DPRDIS ODS CL20 DISTN DOC NAME 

DPRMSG ODS CL255 MESSAGE 

DPRMSGL DS AL1 & LENGTH 
SPACE 

* "ACKNOWLEDGE' COMMAND 
ORG DPRCMD 

DPREXCOD DS CL3 ACK EXCEPTION CODE 

DPRACKR EQU * ACK REPLY 

DPRACKRF DS CL8 FILE: DTM PART OF LADN 
ORG  DPRACKR 

DPRACKRD DS CL20 DISTRIB: DISTN DOC NAME 
ORG DPRACKR 

DPRACKRS ane CL? SEARCH: COUNT VALUE 
SPACE 

* END OF COMMAND PARAMETERS SECTION 

DPRCMDL ae *=DPRCMD LENGTH OF COMMAND PARAMETERS 


* DOC PROFILE PART 
DPRPROF EQU ™* 


DPRDOT ODS H DOC TYPE 

DPRSYS DS CL13 SYSTEM ID VALUE 
DPRPGC DS F PROFILE GCID 
DPRLAD ODS CL8 LADN (DTM PART ONLY) 
DPRACC DS CL4 ACCESS CODE VALUE 
DPRACCL DS AL1 AND LENGTH 
DPRDON DS CL15 DOCUMENT NAME 
DPRDONL ODS AL1 & LENGTH 

DPRSUB =—DS CL60 SUBJECT 

DPRSUBL DS AL1 & LENGTH 

DPRAUT DS CL60 AUTHORS 

DPRAUTL DS AL1 & LENGTH 

DPRREC DS CL60 RECIPIENTS © 
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DPRRECL DS 
DPRKEY DS 
DPRKEYL DS 
DPRCOR ODS 
DPRCORL ODS 
DPRPROFL EQU 


SPAC 
DPRLEN EQU 


A 
: *-DPRPROF 


*=DPR 


& LENGTH 
KEYWORDS (SEARCH TERMS) 
& LENGTH 
CORRELATION DATA 
~& LENGTH 
LENGTH OF PROFILE SECTION 
LENGTH OF DPR DSECT 
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B.1.3 APIRET 


FOO OOOO IOI GOO IOI OOO OGIO OIG IOI III IOI II IOI III IORI CIOII OE 


* DEFINE THE STRUCTURE RETURNED BY RETRIEVE * 
KKK KKK KIKI KKK IKK KK KK IK KKK KK IKK KKK K KK IK KKK IKK IKK K KKK KK KKK KKKK KK HK KKK KKK 
SPACE 
APIRET  DSECT AREA FOR CICS RETRIEVE 
RET DS OF 
RETAPID DC  CL4"APID! IDENTIFIER (WE HOPE) 
RETDIUID DS _—CL16 DIU ID OF ORIGINAL REQUEST DIU 
RETKEY DS  OCL16 KEY VALUE TO PASS ON ACTIVATE 
RETNAME DS  CL8 USER NAME 
RETTIME DS  CL8 TIME STAMP 
RETLEN EQU  *-RET 
SPACE 


B.1.4 APIREGS 


HI KK I KI KI KI KI IK KKK IK OK III KIO IOI OOK IO KOK KICK KK KK KK 


* * 

* RISC SAMPLE DISOSS API ROUTINES - STANDARD REGISTER EQUATES ‘ 

* 

KEI KKKKKKKKK IK KKK KKK KKK KKK KKK KKK IK KKK KKK KKK KKK KK KKK Kk Kk KK KK KK KK KKK 
SPACE 

RO EQU 0 USED TO HOLD LENGTHS ETC. 

R1 EQU 1 USED TO HOLD ADDRESSES 

R2 EQU 2 

R3 EQU 3 MODULE BASE 

R4 EQU 4 

R5 FQU 5 

RE FOU 6 

R7 EQU 7 

R8 EQU 8 ADDRESSES COMMON AREA 

RO EQU 9 API CONTROL BLOCK POINTER 

R10 EQU 10 

R11 FQU 11 EIB ADDRESS 

R12 EQU 12 

R13 EQU 13 DYNAMIC STORAGE REGISTER 

R14 EQU 14 

R15 FQU 15 
SPACE 
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B.2 PL/I CONTROL BLOCKS 


B.2.1 APICOMP 


[BKK HH HK HK HK IKK HK KKK KK IK KKK I FH IK IKK III IE IE IE I TEKH ICICI IK ICH III IE I IKK RK IK IK 


/* (APICOMP) - API COMMON AREA - PLI VERSION - API SAMPLE PROGRAMS */ 


[REE EEEEAE ERAN RARRERA EARN EAE RRAKEXLEN RARE RRA RIK RRA ERK 


DCL COMPTR POINTER; 


DCL 
1 APICOM BASED(COMPTR), 


COMDACK BIT 


2 

2 COMXC CHAR(8), 
2 COMXT CHAR(4), 
2 


COMPARMS , he 
COMP1 POINTER, /* 
COMP2 POINTER, 
COMP3 POINTER, 
COMP4 POINTER, 
COMPS POINTER, 
COMP6 POINTER, 
COMP7 POINTER, 


COMCPTR POINTER, [= 
COMRETCD FIXED BINC31), 


COMXN SHAR) hs 


GO G2 Go G Go WD OD 


COMREASN FIXED BIN(31 
COMDPTR POINTER, . 
COMDLEN FIXED BIN(15), 


COMDPRP POINTER, es 
COMDIUP POINTER, /* 


COMPARSE,, oa 
COMDBUFP POINTER, 
COMLDIU1 FIXED BIN(15 : 
COMLDIU2 FIXED BIN(15), 
COMLDIU3 FIXED BIN(15), 
COMLDIU4 FIXED BIN(15), 
COMDCMD HARES 
COMDST CHAR(1), 7* 


2 COMTRFLG CHAR(1), fs 
2 COMTRSP CHAR(1), (an 6 


RO NO Ro RO RS RO RO RO PO 


GS GW GI bo GW G® WW 


EYE CATCHER NAME 
DISOSS FUNCTION CODE 
TRANSACTION ID 


USED IN ASSEMBLER SUBROUTINES 
CAN BE USED IN MAINLINE 


DISOSS API CONTROL BLOCK POINTER 


/* RETURN CODE VALUE 
ps REASON CODE VALUE 


* DATA POINTER 


/* DATA LENGTH 
COMSPARI FIXED BIN(15), /* SPARE HALFWORD 


DPR BLOCK POINTER 
DIU BUFFER POINTER 


AREA USED BY PARSER ROUTINE 


/* COMMAND CODE 
PARSING STATUS BYTE | 


TRACE FLAG. IF "T" THEN ALL DISOSS 
oe WILL BE TRACED 
GNMENT */ 


OR ALI 
2 COMTRREG(16) FIXED BIN(31); /* USED BY ASSEMBLER ROUTINES 


8) INIT 


00000010°B 


DCL 
COMDDLV ane) INI 000010 8. 


COMDSON BIT 


8) INIT 


DCL 
COMTRYES CHAR(1) INIT('T'); 
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'00000011'B 
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re 


B.2.2 APIDPRP 


Profile and command parameter 
DBTSOF1. 


DCL 


1 APIDPR BASED(COMDPRP), 


DCL 


3 


DPRRESV 


5 DPRRESV1 FIXED BIN 
5 DPRRESV2 FIXED BIN 
5 DPRRESV3 FIXED BIN 


DPRCMD CHAR( 300), 


DPRPROF 


DPRLAD CH 

DPRACC CHAR( 4 
DPRACCL BIT(8 
DPRDONL BIT(8 


DPRSUBL BIT(8 


DPRRECL BIT(8 


O71 O71 O71 O07 OF OF O71 071 OF OF7 O71 OT O71 OT 0 1 


DPRDON CHAR( 15), 
DPRSUB CHAR(60}, 
DPRAUT CHAR(60), 
DPRAUTL BIT(8), 

DPRREC CHAR(60), 


DPRKEY CHAR(60), 
DPRKEYL BIT(8); 


15 
15 
31 


DPRDOT FIXED BIN(15), 
DPRSYS CHAR(13), 
DPRPGC cIXED BIN(31), 


1 DPRCMD1 BASED(COMDPRP), 


DCL 


Co GO GD G W 


3 DPRRESV1 FIXED BIN 
3 DPRRESV2 FIXED BIN 
3 DPRRESV3 FIXED BIN 


DPRRID CHAR(8 
DPRDDN CHAR(8), 
DPRDIS CHAR(20), 


bd 


DPRSID CHAR a) 


DPRMSG CHAR( 255), 


DPRMSGL BIT(8); 


Lo 
15 
St 


1 DPRCMD2 BASED(COMDPRP), 


3 DPRRESV1 FIXED BIN 
3 DPRRESV2 FIXED BIN 
3 DPRRESV3 FIXED BIN 


3 DPREXCOD BIT(18), 


3 DPRACKR C 
DPRACKRF CHAR 
DPRACKRD CHAR 
DPRACKRS CHAR 


HAR(20), 

8) BASED 
20) BASED 
7) BASED 


| 


15 
15 
31 


ADDR 
ADDR 
ADDR 


’ 
3 


3 


3 


$ 
3 
3 


: 


area - PL/I. Used by programs 


DPRACKR 
DPRACKR 
DPRACKR 


bd 
b 


° 
b 


DBTSON1 and 
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B.2.3  APIDPRP2 


Profile and command parameter area - PL/I. Used by CICS program DBTSND1. 
This is a modification of the original APIDPRP. 


DCL 
1 APIDPR BASED(COMDPRP) , 
3 DPRRESV, 
9 DPRRESV1 FIXED BIN(15), 
9 DPRRESV2 FIXED BIN(15), 
9 DPRRESV3 FIXED BIN(31), 


3 DPRCMD CHAR( 300), 


3 DPRPROF, 

DPRDOT FIXED BIN(15), 
DPRSYS CHAR(13), 
DPRPGC FIXED BIN(31), 
DPRLAD CHAR(8), 
DPRACC CHAR(4), 
DPRACCL BIT(8), 
DPRDON CHAR(15),. 
DPRDONL BIT(8), 
DPRSUB CHAR(60), 
DPRSUBL BIT(8), 
DPRAUT CHAR(60), 
DPRAUTL BIT(3), 
DPRREC CHAR(60), 
DPRRECL BIT(8), 
DPRKEY CHAR(60), 
DPRKEYL BIT 8), | 
DPRCOR CHAR(16), 
DPRCORL BIT(8); 


DCL 
1 DPRCMD1 BASED(COMDPRP), 
3 DPRRESV1 FIXED BINT) 


OFT OF OF OF OF OF OFT OF OT OF O07 O71 07 OF 0 071 7 


3 DPRRESV2 FIXED BIN(15 
3 DPRRESV3 FIXED BIN(31 


3 DPRSID CHAR(8), 

3 DPRRID CHAR(8), 

3 DPRDDN CHAR(8 

3 DPRDIS CHAR 20), 

3 DPRMSG CHAR 255), 
3 DPRMSGL BIT(8); 

D 


PRCMD2 BASED(COMDPRP), 
3 DPRRESV1 FIXED BIN T8) 


DCL 
] 


3 DPRRESV2 FIXED BIN(15 
3 DPRRESV3 FIXED BIN(31 
3 DPREXCOD BIT(18), 
3 DPRACKR CHAR(20), 
DPRACKRF CHAR(8) BASED( ADDR(DPRACKR 
DPRACKRD CHAR(20) BASED(ADDR( DPRACKR 
DPRACKRS CHAR(7) BASED(ADDR(DPRACKR 
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B.2.4 APIRETP 
API response start data area. Used by programs DBTSON1 and DBTSOF1. 


DCL RETPTR POINTER; 

DCL 1 APIRET BASED(RETPTR), 
2 RETAPID CHAR(4), — 
2 RETDIUID CHAR? 143 
2 RETDIUI2 CHAR(14), 
2 RETNAME CHAR(8), 
2 RETTIME CHAR(8); 

DCL RETSON CHAR(2) INIT('0O1' 
RETOBT CHAR(2) INIT( ‘02! 
RETFIL CHAR(2) INIT( ‘03! 
RETSOF CHAR(2) INIT( ‘04! 


we w we we 


B.2.5 APIRETP2 


API response start data area. Used by program DBTRSP1. This is a modifica- 
tion of the original APIRETP. 


DCL RETPTR POINTER; 

DCL 1 APIRET BASED(RETPTR), 
2 RETAPID CHAR(4), 
2 RETDIUID CHAR(16), 
2 RETNAME CHAR(8), 
2 RETTIME CHAR(8); 

DCL RETSON CHAR(2) INIT('0O1' 
RETOBT CHAR(2) INIT(‘'02' 
RETFIL CHAR(2) INIT( ‘03! 
RETSOF CHAR(2) INIT(‘'04!' 


we w @ ww 
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B.3 ASSEMBLER MACRO 


B.3.1 APICALL 


This is the macro used for subroutine calls. 


MACRO 
& NAME APICALL &ENTRY,&OPRNDS 
—  LCLA O&N,&C 8A 
&N SETA N'&OPRNDS 
&C SETA 0 
~ AIF  ('&NAME' EQ '').NONAME 
&NAME DS OF 
.NONAME ANOP 
L RO,DFHEIBP LOAD EIB POINTER 
ST RO,COMP1 STORE IN PARM LIST 
LA RO ,APICOM LOAD ADDR OF APICOM 
ST RO, COMP2 STORE IN PARM LIST 
. LOOP ANOP 
&C SETA &C+1 
AIF (&C GT &N).BAL 
&A SETA &(C+2 
LA RO, &OPRNDS(&C) ADDRESS OF PARM 
ST RO, COMP&A STORE IN LIST 
AGO  .LOOP 
»BAL ANOP 
LA R1 , COMPARMS ADDRESS OF PARAMETERS 
L 15 ,=V(&ENTRY. ) LOAD 15 WITH ENTRY ADR 
BALR 14,15 BRANCH TO ENTRY POINT 
L R15,COMRETCD RETURN CODE IN R15 
L RO, COMREASN & REASON CODE IN RO 
MEND 
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B.4 SUBROUTINE LISTINGS 


B.4.1 APIACTIV 


ACT TITLE '*APIACTIV* - PERFORM DISOSS "ACTIVATE" - DISOSS API SAMPLE * 
PROGRAMS ! 


PRINT NOGEN 
APIACTIV CSECT 


KHKHKKKKKIKKEKKKK KK KKH KK KKK KKK KKK KKK IKK KK KKK KK AKK KK KK KKHEHKKKEKKKKKKIHKKKK KKK 


SUBROUTINE TO DO A DISOSS 'ACTIVATE' 


INPUT PARMLIST: 
-> NAME (8 BYTES) 
-> TIME STAMP (8 BYTES) 


OUTPUT: COMRETCD HAS RETURN CODE. 
= 8 : BAD RETURN FROM DISOSS CALL. 
DISOSS RC IN COMREASN 


HMHEKKKIKKAKKEKK KKK KKK KKK KK KKKKKKKKKK KEKE KKKKKKKEKKKKKKKK KI KK KK KKK KKK KK KK 


SPACE 
E R8,4(R1) APICOM ADDRESS 
USING APICOM, R8 

SPACE 

XC ACTRSV,ACTRSV ZERO RESERVED FIELD 
L R4,8(R1) GET NAME POINTER 
MVC ACTNAME,0(R4) MOVE IN USER NAME 

L ,12(R1 ADDR OF TIME DATA 
MVC ACTTIME , 0(R4) MOVE INTO STD PARMS 
LA —_-RO,ACT GET COMMAND DATA 

ST  RO,COMDPTR & TELL DISOSS 

LA RO, ACTLEN GET DATA LENGTH 

STH RO, COMDLEN TELL DISOSS 


SPACE 
Space” APIDISOS ,(=CL8'ACTIVATE') 
* WE a WITH THE RETURN CODE FROM DISOSS 


R15, COMREASN OUR REASON Seas TS DISOSS RC 
LTR R15,R15 WAS IT BAD RC ? 
BZ *+8 NO, USE ZERO AS OUR RC 
LA R15,8 OTHERWISE WE HAVE RC 8 
ST R15, COMRETCD 
EJECT 
DFHEISTG DSECT 
ACT DS OF ACTIVATE PARAMETER DATA 
ACTNAME DS CL8'USERNAME ! USER NAME GOES HERE 
ACTTIME ODS XL8 TIME VALUE 
ACTRSV DS XL4 RESERVED 
ACTLEN EQU *-ACT 
SPACE 
PRINT OFF 


COPY APICOM 
COPY APIDPR 


* 
* 
* 
* 
* 
i COMCPTR IS SET TO ZERO BY CALLER IF THIS IS A FIRST TIME CALL 
* 
* 
* 
* 
* 


* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
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COPY APIREGS 
PRINT ON 
END 
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B.4.2 APIDIUSB 


This is a collection of DIU element building subroutines. Used by program 


DBTSON1 via routine APISGNON 


KHKK IKK HK KK KKK KKH IKK HK IKK IKK KIKI HK KKH KK IK KH HK KKK KKK KICK KK KKK KK KKK HK KKK KKK 


* SUBROUTINES TO BUILD DIU ELEMENTS * 
KKK IKIKK KIKI KIKI IKK IKK KIKI KKK IKK IKK IK KI K KKK I KKK K KE KAKA KKK KKK KKK KK KKK KKK KKK 
* REGISTERS ARE NOT SAVED IN THESE ROUTINES. * 
* REGS 0,1 CARRY PARAMETER VALUES AND ARE ALSO USED AS WORK REGS. * 
* REG 15 IS OCCASIONALLY USED AS A WORK REGISTER * 
* REG 2 POINTS TO THE CURRENT POSITION IN THE OUTPUT BUFFER * 
KHIK HK IK IKI K HK HK KKK HK KK IKK KKK KIKI KKK KKK IKK KKK KKK KKK KKK KK KKK IK KKK KKK KKK HK 
HHH KKH IKI HK IH HH IK IH KH IK HK IK IIH IK IKK IK HK HK HII IH KK KK AIK HH K IK KH KI KKKKKKKKKKKKKKKK KKK 
* PREFIX AND SUFFIX BUILDERS * 
KHKKKKHI KK KIKI HK IKK KH KKK AK KI KKK KKKKKK KKK KKK KKK KICK KK KKK KK KKK KKK KKK KK I KKK 

SPACE 
DIUPFX DS OF 

LR R15, RO LENGTH OF CORRELATION DATA 

LA RO, 9( R15) ADD 5 FOR LLCTF 

STH RO, 0(R2) STORE LL VALUE 

MVC 2(3,R2),=X'CO0102' MOVE CTF DATA 

BCTR Ri5,0 -1 FOR EXECUTE 

EX R15, MVCPFX MOVE IN CORRELATION DATA 

LA —-R2, 6(R15,R2) POINT AT NEXT AVAIL BYTE 

BR R14 & RETURN 

SPACE 
MVCPFK MVC 5(1,R2),0(R1) EXECUTED MOVE 

SPACE 2 
DIUSFX DS 

MVC 203, R2) ,=X'CFO100' STANDARD SUFFIX DATA 

LA RO, 5 FIXED LENGTH 

STH RO, O¢R2) OF FIVE 

LA R2,5(R2 INCREMENT BUFFER POINTER 

BR R14 & RETURN 
pumaeeies | ee cee eee eee 
* COMMANDS : 
KHKKKKK KK IKI KKK KK KK HK KI KK KKK K KKH HK HK KKK IKKE KKK KKK KKK KKK KKKKKKKKKK KK KKK 

SPACE 
FILECMD DS OF BUILD A DIU 'FILE' COMMAND 
* LL ADDED LATER 

MVC = _2(3,R2) ,=X'CC0201' MOVE CTF 

LA R2,, 5(R2) INCR BUFFER POINTER 

BR R14 RETURN TO CALLER 

SPACE 2 
SONCMD DS OF BUILD A DIU 'SIGNON' COMMAND 
* LL ADDED LATER 

MVC © 2(3,R2) ,=X'CDOCOL' MOVE CTF 

LA R2,, 5(R2) INCR BUFFER POINTER 

BR R14 RETURN TO CALLER 

SPACE 2 
OBTCMD DS OF BUILD A DIU 'OBTAIN' COMMAND 
* LL ADDED LATER 

MYC 2(3,R2) 5=X"CC1701' MOVE CTF 

LA R2, 5(R2) INCR BUFFER POINTER 

BR R14 RETURN TO CALLER 
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SPACE 
DISCMD DS 


MVC 
LA 
BR 


2 


OF | BUILD A DIU ' DISTRIBUTE! COMMAND 
| LL ADDED LATER 

2(3,R2),=X'CC1CO1' MOVE CTF 

R2,5(R2) INCR BUFFER POINTER © 


RETURN TO CALLER 


HHH HII IKK HHH HK I KIKI HK IK KK KICK II IK ROK IKI KI I IK KICK IOI IK III KK IK I KKK IOK KKK KK 


* PARAMETERS FOR 'FILE' & 'DISTRIBUTE' 


JOII SIO IG IOI IS OIO SOO SOS OIGG I OISOI IS OCO IS IIOSOI I OOI III O I OSIT I I ITOT I TS. ae: 


S 
IDDATA1 ODS 


S 
ACCCODE DS 


DUSEGN DS 
DUSEGL DS 


DUSYS DS 
* 


PRDOC DS 
* 


PRBASE DS 
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OF | 
2(3,R2),=X'C52001' 
,9(R2) 
RO,6 
RO,0 RS 
RO Be RD 
R14 

2 
OF 

503° Ros 
9(2,R2 


RO ,O(R1 
oae4 R2 


RO,O0(R2) 
R2.11(R2). 
R14 

2 

OF 


2(6,R2) ,=X'C90381200000' 
R2,8(R2) 


»=X'C33941' 
,=X'0601' 


3 


Z 
OF 


2(6,R2) ,=X'C90381000000' 
8(R2) 


b] 


2(3,R2),=X'CA0301' 
R2,5(R2) 


3 


2 
OF 


2(3,R2) ,=X'CAO401' 
R?,5(R2} 
R14 


* 


MOVE CTF 
IDENTIFIED DATA IN RO 


SEP Lb | 
INCR BUFFER POINTER 


SET CTF VALUE © 

LENGTH + TYPE 

LOAD ACCESS CODE VALUE 
SET ACCESS CODE VALUE 


SET LL VALUE 
UPDATE TOTAL LENGTH 


LL SET LATER 
SEGMENT INTRODUCER 
INCREMENT BUFFER PTR 


LL SET LATER 
SEGMENT INTRODUCER 
INCREMENT BUFFER PTR 


LL SET LATER 
SET DOC TYPE 
MOVE SYSTEM ID 
INCR BUF PTR 


LL SET LATER 
CTF | 
INCR BUF PTR 


LL SET LATER 
CTF 
INCR BUF PTR 
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PRBTYPE 


PRBGCID 


PRBDOCN 


MVCPRBD 
PRBSUBJ 


MVCPRBS 
PRBAUTH 


MVCPRBA 
PRBT IME 


SPACE 2 
DS 


OF 
MVC = 2(3, ae =X'C70601' 
STH RO ,5(R2 ) 
LA RO,7 
STH RD TPR 
LA R2,/7(R2 
BR R14 
SPACE 2 
DS OF 


ST RO, 
LA 


LA R2,9(R2 
BR 

SPACE 2 

DS OF 

LR R15, RO 

LA OOS 
STH RO,O(R2 


) 
MVC (3; R2) ,=X'C70001' 
BCTR R15,0 
EX R15, ,MVCPRBD 
LA R2 ,6(R15, R2) 
BR R14 


MVC =5(1,R2),0(R1) 


DS OF 
LR R15,RO 
LA RO,5(R15) 


STH RO, 0(R2) 
MVC a3, R2), ,=X'C70B01! 


EX R15, MVCPRBS 
LA R2 ,6(R15, R2) 
BR R14 


MVC =—5(1, R2) ,O(R1) 


DS OF 
LR Sere 
LA RO,5(R15) 


STH RO, O(R2) 

MVC 2(3,R2),=X'C70401' 
BCTR R15,0 

EX _R15,MVCPRBA 

LA —R2,6(R15,R2) 

BR seR14 | 


MVC 5(1,R2),0(R1) 


DS OF 

MVC eC °ROY DATETIME 
MVC 8 =5(6,R2) DATETIME 
LA RO,11 

STH  RO,O(R2) 

LA R2,11(R2) 

BR R14 


CTF 
DOC TYPE 


SET LL VALUE 
INCR BUF PTR 


CTF 
SET GCID/GPID 


SET LL VALUE 
INCR BUF PTR 


LENGTH OF DOC NAME 

ADD 5 FOR LLCTF 

STORE LL VALUE 

MOVE CTF DATA 

-1 FOR EXECUTE 

MOVE IN DOC NAME 

POINT AT NEXT AVAIL pane 
& RETURN 


EXECUTED MOVE 


LENGTH OF SUBJECT FIELD 
ADD 5 FOR LLCTF 

STORE LL VALUE 

MOVE-CTF DATA 

-1 FOR EXECUTE 

MOVE IN SUBJECT 

POINT AT NEXT AVAIL BYTE 
& RETURN 


EXECUTED MOVE 


LENGTH OF AUTHOR FIELD 
ADD 5 FOR LLCTF 

STORE LL VALUE 

MOVE CTF DATA 

-1 FOR EXECUTE 

MOVE IN AUTHOR NAME 
POINT AT NEXT AVAIL BYTE 
& RETURN 


EXECUTED MOVE 

CTF VALUE 

STD VALUE FOR THE MOMENT 
LENGTH 


POINT TO NEXT FREE BYTE 
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SPACE 
DATETIME DC arrears iia AL1(21), AL1(22), ane): 
* 22.30 ON 21ST MAY 198 


KKK IK HK KK KKK KKK KKK KK KKK KKK KKK KK KI KKK KKK KK IK KKK KIKI IKK KKK KKK IKK KKK KKK IKK 


* PARAMETERS FOR 'SIGNON' | | : 
HEI AIK KKK HK KH KK IKK EK KC HK IH HK HK ICH HH HE FE HICK IK KK ICH HK IK KKK IK KK KKK KKK KK KK KK KK KKK 
SPACE 
FUNCSETS DS OF 
LR R15,R0 LENGTH OF NAME FIELD 
LA RO’ Orne) ADD 5 FOR LLCTF 
STH RO,O(R2) STORE LL VALUE 
MVC ae R2) ,=X'C31201' CTF VALUE 
BCTR R15,0 -1 FOR EXECUTE 
EX R15 ’MVCFUNC MOVE IN FUNC SETS STRING 
LA R2 ,6(R15, R2). POINT AT NEXT AVAIL BYTE 
BR R14 & RETURN 
SPACE 
MVCFUNC MVC  5(1,R2),0(R1) EXECUTED MOVE 
SPACE 
SONNAME DS OF 
LR R15,RO LENGTH OF NAME FIELD 
LA nO OtR2) ADD 5 FOR LLCTF 
STH RO,O(R2) | STORE LL VALUE 
MVC) = =2(3,R2) ,=X'C30D01' MOVE CTF DATA 
BCTR R15,0 -]1 FOR EXECUTE 
EX R15 .MVCSONN MOVE IN USER NAME 
LA R2,6(R15,R2) POINT AT NEXT AVAIL BYTE 
BR R14 & RETURN 
SPACE 
MVCSONN MVC 5(1,R2),0(R1) EXECUTED MOVE 
SPACE 
SONPASS DS OF 
LR R15,RO LENGTH OF PASSWORD 
LA ROOF Re} ADD 5 FOR LLCTF 
STH RO,OCR2) STORE LL VALUE 
MVC =. 2(3,, R2) ,=X'C33801' MOVE CTF DATA 
BCTR R15,0 -~] FOR EXECUTE 
EX R15 .MVCSONP MOVE IN PASSWORD 
LA R2,6(R15,R2) POINT AT NEXT AVAIL BYTE 
BR R14 & RETURN 
SPACE 
MVCSONP SDAGE 5(1,R2),0(R1) EXECUTED MOVE 
RCVDOCS DS OF SINGLE RECEIVE DOC TYPE 
MVC = 2(3,, R2) ,=X'C32901' CTF 
STH RO,5(R2) STORE DOC TYPE 
LA RO,7 LENGTH 
STH RD aeRO STORED IN LL FIELD 
LA R2,7(R2 BUMP BUFPTR 
BR R14 
SPACE 


KHHKKKKRIKKKK KK KKK KKK KKK KKK KKK KKK KKK KKK HK KKK IK KKH KKK KKK IKK KKKKKKEKKEK KKK KEKE K 


* PARAMETERS FOR ‘OBTAIN’ 


HORI K IKK KICK HK KK IKK IK IK KI KIKI KKH KH II KK KICK HK KKK KIKI K EK KK KKK KKK KK KKK KKK KK KK 


OBTOPTS 


SPACE 

DS OF 

MVC) 3 =2(3,R2),=X'C31E01' 
STC RO,5(R2) | 

LA R 


3 


ee ence 
STORE OPTION BYTE 
LENGTH 
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STH RO,0(R2) 
LA —-R2.,6(R2 
BR R14 
SPACE 


STORED IN LL FIELD 
BUMP BUFPTR 


KHKKKKKKKKK KKK KI KKK IKK KKK KKK KIKI KKK IKK KK KIKI K KKK KKH KK KKK KKK KKKKKEK KKK KKK 


* PARAMETERS FOR 'DISTRIBUTE' 


* 


KIKKKKKI KK IKK KKK KICK KK KEK IKK IKK KKK KK KKK KKK KKK IKK KKK KKKKKIKKKKKKKK KKK KKK KK 


SPACE 
DNADDR DS OF 
LR ——- R15, RO 
LA RO, 8¢RIS) 
STH RO, 0(R2) 
MVC =. 2(3,R2)=X'C32F01' 
BCTR R15,0 


EX _R15,MVCDNAD 
LA —-R2,6(R15,R2) 


BR sR14 
SPACE 
MVCDNAD MVC  5(1,R2),0(R1) 
SPACE 
RECADDR DS OF 
LR ——-R15,RO 
LA RO aC RIS) 
STH RO, O(R2) 
MVC 2(3,R2),=X'C30601! 
BCTR R15,0 


EX R15, ’ MVCRECAD 
LA R2 ,6(R15, R2) 
R14 


S 
MVCRECAD MVC 5(1,R2),0(R1) 


DESTINATION NODE ADDRESS 
LENGTH OF ADDRESS NAME 
ADD 5 FOR LLCTF 
STORE LL VALUE 
MOVE CTF DATA 
-1 FOR EXECUTE 
MOVE IN ADDRESS 
POINT AT NEXT AVAIL BYTE 
& RETURN 


EXECUTED MOVE 


RECIPIENT NAME 
LENGTH OF NAME 
ADD 5 FOR LLCTF 
STORE LL VALUE 
MOVE CTF DATA 
-1 FOR EXECUTE 
MOVE IN NAME 
POINT AT NEXT AVAIL BYTE 
& RETURN 


EXECUTED MOVE 


KKK KKK KI KKK KKK KKK KKK KKK KI KKK KK KKK KKK KKK KKK KKK KK KKK KKK KKK KKKEKKEKKKKKKKK K 


* DOCUMENT BUILDERS 


* 


KKKKK KKK IKK KK IKK KKK KKK HK KH KKK KKK KKK IKK KK IKK KKK KI K KKK KK KKH KKK KKKKKKKKKKE 


SPACE 

DCI DS OF 
MVC =. 2(3,, R2) ,=X'CBO101' 
LA RO,5 ? 
STH RDP ROS 
LA R2 ,5(R2 
BR R14 
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B.4.3 APIDIUS2 


This collection of DIU element building subroutines is a modified version of API- 
DIUSB, and is used by program DBTSNDI1 via routines APIDIS2 and APIFIL2. 


KKKKKKKKK KKK KKK KI KKK KKK KKK KKK KKK KKK HK KKK HK HK IKK KKKKKIKKKEKKKKEKKKKKKKKKKR 


* SUBROUTINES TO BUILD DIU ELEMENTS . 
PRO Ae MN ARDEA TOMEI MIEN AG MeN Ae TON Ae Wy IIR Tee We erty te te ego oe Be Tere ee ae NY Perea eS Iw ee Wee ae ee te Te mete we mee 
* COPY OF APIDIUSB, ADDED OPERANDS FOR . 


’ LENGTH OF CORRELATION DATA 16 BYTES (INSTEAD OF 2), * 

* SOURCE ADDRESS, * 

* DOCUMENT GCID (NOT USED IN DBT... SYSTEM), * 
* ATTRIBUTE LIST * 
RNR INH RAK AER RIK HAH KK IKK IRA AAAI RRA A IAA IIASA IAAI AAA AMAIA IAI 

* REGISTERS ARE NOT SAVED IN THESE ROUTINES. * 

* REGS 0,1 CARRY PARAMETER VALUES AND ARE ALSO USED AS WORK REGS. * 

* REG 15 IS OCCASIONALLY USED AS A WORK REGISTER 

* REG 2 POINTS TO THE CURRENT POSITION IN THE OUTPUT BUFFER === 


KH IKK KIKI KI HK KKK HK IK IK KKH IK KK IK HK HHI KH KH KKH KA KKK KKKAKKKKKKHKKKKKEKKKKKKK KKK 


KHKKIKKIKK IKK KK IKK HK KKK KKK HH K KK KKK KKK KK KKK KKK KKK KKKKKKKKKEKKKKKKKKK KKK KKK 


* PREFIX AND SUFFIX BUILDERS * 
KHIKKKKKEKK KKK KKK KKK KK KK IKK KK IKK IKK KKK IKK KI KIKI KKK KI KHK KI KEKKKKKKKK KK IK KK KK 
SPACE 
DIUPFX DS OF 
LR R15 RO LENGTH OF CORRELATION DATA 
LA RO, seas) ADD 5 FOR LLCTF 
STH RO,0(R2) STORE LL VALUE 
MVC 2(3 R2) ,=X'C00102' MOVE CTF DATA 
BCTR R15,0 -1 FOR EXECUTE 
EX R15, MVCPFX MOVE IN CORRELATION DATA 
LA —-R2,6(R15,R2) POINT AT NEXT AVAIL BYTE 
BR R14 & RETURN 
SPACE 
MVCPFX MVC 5(1,R2),0(R1) EXECUTED MOVE 
SPACE 2 
DIUSFX DS OF 
MVC .2(3,R2) ,=X'CFO100' STANDARD SUFFIX DATA 
LA RO, 5 FIXED LENGTH 
STH RO,O¢ R2) OF FIVE 
LA R2, 5(R2 INCREMENT BUFFER POINTER 
BR R14 & RETURN 
SPACE 2 
KIKKHKKKKKKKK IK KKK KKK IK KKK KKH KKK KKK KH KK KK IK KKKKIKKKKAKKKEKKKKKKKEKKEKAKKKKK 
* COMMANDS * 
FO IOI OOOO IO III IO IOI IO IOI III II IIR IIE III IE III ICICI ICI 
SPACE 
FILECMD DS OF BUILD A DIU 'FILE' COMMAND 
* LL ADDED LATER 
MVC =. 2(3, R2) ,=X'CC0201! MOVE CTF 
LA R2,,5(R2) INCR BUFFER POINTER 
BR R14 RETURN TO CALLER 
SPACE 2 
SONCMD DS OF BUILD A DIU 'SIGNON' COMMAND 
* LL ADDED LATER 
MVC .2(3,R2) ,=X'CDOCO1' MOVE CTF 
LA R2, 5(R2) INCR BUFFER POINTER 
BR R14 RETURN TO CALLER 
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SPACE 2 
OBT CMD DS OF 


MVC  2(3,R2),=X'CC1701! 

LA R2,,5(R2) 

BR R14 

SPACE 2 
DISCMD DS OF 


MVC =. 2(3,R2) ,=X'CC1CO1' 
(R2) 


b] 


BUILD A DIU 'OBTAIN' COMMAND 


LL ADDED LATER 

MOVE CTF 

INCR BUFFER POINTER 
RETURN TO CALLER 


BUILD A DIU ‘DISTRIBUTE’ COMMAND 
LL ADDED LATER 


MOVE CTF 
INCR BUFFER POINTER 
RETURN TO CALLER 


KIKI IKK KIKI KK KKK KI KK IKK IK IKK HK HI KK IK IK IK KH IKK KI KKK KK KKK KK KKK KKKKKKKKKK KKK KKK 


* PARAMETERS FOR 'FILE' & 'DISTRIBUTE' 


* 


HKKHKK KICK HK HH KH KI K KK IK KKH KIKI KIKI KH KK KKK KI KKK KK KKK KK KKK KKK KKK KK KKKKE KKK 


S 
IDDATA1 DS OF 

MVC =. 2(3, R2) ,=X'C52001' 

STC RO,5(R2) 

LA RO 


6 
STH RP ee RDS 


LA —- R2., 6(R2 
BR seR14 
SPACE 2 
SRCADDR DS OF 
LR —-R15,RO 
LA RO, 5(R15) 
STH RO, O(R2) 
MVC .2(3, R2) ,=X'C32301' 
BCTR R15.0 


EX R15,MVCSRCAD 
LA —_—-R2,6(R15,R2) 
R14 

MVCSRCAD MVC 5(1,R2),0(R1) 


ACCCODE DS OF 
MVC 5t2 RO) x" OeL 


MVC 5(2.R2),=X'0601! 
L RO,O(RI1 

ST ——- RO, 7(R2 

LA 0.1] 

STH RO, O(R2) 

LA —-R2, 11(R2) 

BR R14 

SPACE 2 


DUSEGN DS OF 
MVC 71 Telecine 


LA R2,8(R 
BR R14 
SPACE 2 


DUSEGL DS OF 
MVC 2(6,R2),=X'C90381000000' 
R2,8(R2) 


3 


MOVE CTF 
IDENTIFIED DATA IN RO 


SEI EL 
INCR BUFFER POINTER 


SOURCE ADDRESS 


LENGTH OF NAME 

ADD 5 FOR LLCTF 

STORE LL VALUE 

MOVE CTF DATA 

-1 FOR EXECUTE 

MOVE IN NAME 

POINT AT NEXT AVAIL BYTE 
& RETURN 


EXECUTED MOVE 


SET CTF VALUE 
LENGTH + TYPE 
LOAD ACCESS CODE VALUE 
SET ACCESS CODE VALUE 


SET LL VALUE 
UPDATE TOTAL LENGTH 


LL SET LATER 
SEGMENT INTRODUCER 
INCREMENT BUFFER PTR 


LL SET LATER 
SEGMENT INTRODUCER 
INCREMENT BUFFER PTR 
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DUSYS 
* 


PRDOC 
* 


PRBASE 


PRBTYPE 


PRBGCID 


DGCID 


PRBDOCN 


MVCPRBD 
PRBSUBJ 
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SPACE 
DS 


STH © 
MVC 


STH 


2 

OF 

R (R2) 
2(13,R2),0(R1) 
R2,15(R2) 

R14 

2 

OF 
2(3,R2),=X'CAO301' 
R2,5(R2) — 
R14 

2 

OF 


2(3,R2),=X'CA0401' 
5(R2) 


3 


2 
OF 
2(3,R2),=X'C70601' 
RO, 5(R2) 
0,7 
othe) 
R2.7(R2 
R14 
2 
OF 
2(3,R2),=X'C70101' 
RO,5(R2 
RO.9 
te 
R2,.9(R2 
R14 
2 
OF 
ee Cer nne 
2(7,R2),=X'C7050101510100' 
RO,9 
RO, O¢R2) 
R2.9(R2 
R14 
2 
OF 
R15,RO 
aki) 
RO,O(R2) 


0 
ae R2),=X'C70001' 
R15,0 | 


R15. MVCPRBD 
R2,6(R15,R2) 
R14 


5(1,R2),0(R1) 


RO, 2 R15) 
RO.O(R2) 


LL SET LATER 
SET DOC TYPE 
MOVE SYSTEM ID 
INCR BUF PTR 


LL SET LATER 
CTF 
INCR BUF PTR 


LL SET LATER 
CTF 
INCR BUF PTR 


CTF 

DOC TYPE 

SET LL VALUE 
INCR BUF PTR 


CTF 
SET GCID/GPID- 


SET LL VALUE 
INCR BUF PTR 


GCID 215-264 "1403" 
GCID 337-256 'FOR TESTING! 


SET LL 
INCR BUFFER POINTER 


LENGTH OF DOC NAME 

ADD 5 FOR LLCTF 

STORE LL VALUE 

MOVE CTF DATA 

-1 FOR EXECUTE 

MOVE IN DOC NAME 

POINT AT NEXT AVAIL BYTE 
& RETURN 


EXECUTED MOVE 
LENGTH OF SUBJECT FIELD 


ADD 5 FOR LLCTF 
STORE LL VALUE 
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MVCPRBS 
PRBAUTH 


MVCPRBA 
PRBTIME 


ACE 
DATETIME DC 
* 22.30 ON 21ST MAY 1 
SPAC 


KKK KKK KKK IKK IKK KI KKK IKK IKK IKK KI KKK KK IKI KI KKH KKK IKK KK KKK KKK KKK KK KK KKK K 


* PARAMETERS FOR 'SIGNON' 


KEIKKKI KKK KKK KKK KKK KKK KKK IKK KI KKK KKK KKK KI IKK KKK KKK KKK KK IKK KK KKKKKKKKKK KK 


FUNCSETS 


MVCFUNC 
SONNAME 


MVCSONN 
SONPASS 


2(3,R2),=X'C70B01' 
R15,0 


R15,MVCPRBS 
R2 ,6(R15, R2) 
R14 


5(1,R2),0(R1) 


, 0 
2(3, RO) =X'C70401' 
R15,0 
R15, ,MVCPRBA 
R2 ,6(R15, R2) 
R14 


5(1,R2),0(R1) 

OF 

aba ROY DATETIME 
5(6,R2),DATETIME 
RO,11 


RO, 0(R2) 
R2.11(R2) 
R14 


MOVE CTF DATA 

-1 FOR EXECUTE 

MOVE IN SUBJECT 

POINT AT NEXT AVAIL BYTE 
& RETURN 


EXECUTED MOVE 


LENGTH OF AUTHOR FIELD 
ADD 5 FOR LLCTF 

STORE LL VALUE 

MOVE CTF DATA 

-] FOR EXECUTE 

MOVE IN AUTHOR NAME 
POINT AT NEXT AVAIL BYTE 
& RETURN 


EXECUTED MOVE 

CTF VALUE 

STD VALUE FOR THE MOMENT 
LENGTH 


POINT TO NEXT FREE BYTE 


AL2(1983), AL1(05) ,AL1(21) ,AL1(22) ,AL1(30) 


“0 
23, 2), =X'C31201' 
R15, MVCFUNC 

R2 ,6(R15,R2) 

R14 

5(1,R2),0(R1) 

OF 

R15,RO 

RO,5(R15) 

RO, O(R2) 

23, R2),=X'C30D01! 
R15,0 

R15 .MVCSONN 

R2 6(R15,R2) 

R14 

5(1,R2),0(R1) 


OF 


* 


LENGTH OF NAME FIELD 

ADD 5 FOR LLCTF 

STORE LL VALUE 

CTF VALUE 

-1 FOR EXECUTE 

MOVE IN FUNC SETS STRING 
POINT AT NEXT AVAIL BYTE 
& RETURN 


EXECUTED MOVE 


LENGTH OF NAME FIELD 

ADD 5 FOR LLCTF 

STORE LL VALUE 

MOVE CTF DATA 

-1 FOR EXECUTE 

MOVE IN USER NAME 

POINT AT NEXT AVAIL BYTE 
& RETURN 


EXECUTED MOVE 


API and DIU-build Subroutines 


125 


LR R15,RO LENGTH OF PASSWORD 


LA RO, BORD) ss ADD 5 FOR LLCTF 
STH  RO,0(R2) STORE LL VALUE 
MVC 2(3, R2), a4 C33801' MOVE CTF DATA 
BCTR R15,0 ee =]. FOR EXECUIE® 
EX R15, ” MVCSONP MOVE IN PASSWORD | 7 
LA R2 ,6(R15, R2) | POINT AT NEXT AVAIL BYTE 
BR R14 & RETURN 
SPACE | 
MVCSONP SBEGE 5(1,R2),0(R1) EXECUTED MOVE 
RCVDOCS DS OF SINGLE RECEIVE DOC TYPE 
MVC) 3 =2(3,R2) ,=X'C32901' CTF | 
STH RO,5(R2) STORE DOC TYPE 
LA RO,/ | LENGTH _— 
STH RD TE ROS STORED IN LL FIELD 
LA R2,7(R2 BUMP BUFPTR 
BR R14 
SPACE 
KHKKKI KKK KKK KI KH K IK KKK KKK KK IKK KK KIKI KKK KA K KEKE KK KKK KKKK HK KKKKKE KKK KKK KKK 
* PARAMETERS FOR 'OBTAIN' ¢ 
HIKE IK IKK KKK KIKI KKK IK KKK IK KKK KKK IKK HI KKH KKK KIKI KK KKK KK HK KKK KKK HK IKK HK HK KK 
SPACE 
OBTOPTS DS OF OBTAIN-OPTIONS 
MVC =. 2(3, R2) ,=X'C31E01' CTF 
STC RO 5(R2 ) STORE OPTION BYTE 
LA RO ,6 LENGTH 
STH RO, O(R2) STORED IN LL FIELD 
LA R2 ,6(R2 BUMP BUFPTR 
BR R14 
ET hee eT ee Te ane ee mT ener ear vere 
* PARAMETERS FOR 'DISTRIBUTE' " 
KKK KKK KKK IK KKK KKK KI KKK IKK K HK KKK KI KK KIKI KH KH KI KKK IKKE IKK KKK IKK KKK KKK KKK 
SPACE 
DNADDR ODS OF DESTINATION NODE ADDRESS 
LR R15,RO LENGTH OF ADDRESS NAME 
LA RO,5(R15) ADD 5 FOR LLCTF 
STH  RO,O(R2) STORE LL VALUE 
MVC 2(3, R2) ,=X'C32F01' MOVE CTF DATA 
BCTR R15,0 =] ‘FOR EXECUTE 
EX R15, ’MVCDNAD MOVE IN ADDRESS 
LA R2 ,6(R15, R2) POINT AT NEXT AVAIL BYTE 
BR R14 & RETURN 
SPACE 
MVCDNAD MVC  5(1,R2),0(R1) EXECUTED MOVE 
SPACE 
ATTLST DS 


OF 
2(7,R2),=X'C3050100000001' MOVE CTFATL 


SET LL 
INCR BUFFER POINTER 


LA R2 ,9(R2 
BR R14 
SPACE 2 

RECADDR DS OF RECIPIENT NAME 
LR R15,RO LENGTH OF NAME 
LA RD OP R2). ADD 5 FOR LLCTF 
STH RO,O(R2) STORE LL VALUE » 
MVC =2(3,R2) ,=X'C30601' MOVE CTF DATA 
BCTR R15,0 ~1 FOR EXECUTE 


126 Connecting non-DIA Systems to DISOSS 


EX R15 ,MVCRECAD MOVE IN NAME 


LA —-R2,, 6(R15,R2) POINT AT NEXT AVAIL BYTE 
BR R14 & RETURN 
SPACE 
MVCRECAD MVC 5(1,R2),0(R1) EXECUTED MOVE 
Fs ae eee eee eC ee Te eee Ree nner! 
* DOCUMENT BUILDERS * 
KK IKK HK KK KIKI KIKI KIKI KI KKK KKH KH KI HK KK KKK IKK KK KKK KI KH KKK KK KKK KKKKKKK KK KKK 
SPACE 
DCI DS OF 
MVC. 2(3,R2),=X'CBO101' 
LA RO, 5 
STH RO,O¢R2) 
LA —-R2,5(R2 
BR R14 
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B.4.4 APIDISOS | 


DIS TITLE aa - CALL DISOSS INTERFACE - DISOSS API SAMPLE PROG* 


PRINT NOGEN 
APIDISOS CSECT 


KIKI IK IKK III KI IK IK II IK KOK IK II KK KICK IK I KOKI KI RIK KK KIKI KICK IK IK KICK III KICK IIE KI IK KEK 
x 


(APIDISOS) - SUBROUTINE TO DO DISOSS CALLS 
INPUT PARMS: <-> APICOM 


* * 
* * 
* * 
* -> COMMAND VERB * 
ON EXIT, THE DISOSS RETURN CODE IS IN COMRETCD 4 
* * 


KHEKIKKKHIKHK KKK KKH KK KIKI KK IK KI K HK KIKI KKH KKK KKK KI KH K KIKI KKKKEKKEKKKKKKEREKKKKK 


SPACE 

L R8,4(R1) LOAD APICOM ADDRESS 
USING APICOM,R8 

esate R4,8(R1) LOAD ADDRESS OF VERB 

MVC  COMXN,=C'*APICOM*' & EYE CATCHER 

MVC  COMXC,0(R4) COMMAND VERB 

SPACE 

LA RO, COMXC | ADDRESS THE COMMAND VERB 
ST RO, COMP 1 STORE ADDRESS OF COMMAND VERB 
XC COMRETCD , COMRETCD ZERO RETCODE FIELD 

LA RO, COMRETCD RETCODE FULLWORD 

ST RO, COMP2 

LA RO,COMCPTR CONTROL BLOCK POINTER 

ST RO, COMP3 

LA RO ,COMDPTR DATA POINTER 

ST RO , COMP4 | 

LA RO, COMDLEN DATA LENGTH 

ST RO ,COMP5 | 

OI COMP5 ,X'80' SET VL BIT 


SPACE 
* TRACE IF TRACE FLAG IS SET 
CLI COMTRFLG,COMTRYES acne WE TRACE ? 


BNE DIS] 
STM  RO,R15,COMTRREG SAVE ALL REGS 
EXEC CICS ENTER TRACEID(1) 
LM RO,R15,COMTRREG RELOAD REGS 
DIS1 EQU * 
SPACE 
e NOW ASK DISOSS TO PROCESS THE REQUEST 
LA R1,COMPARMS Rl -> PARM LIST 
L R15, =V(DSVAW000 ) INTERFACE ROUTINE ADDRESS 
BALR R14, R15 | CALL DISOSS 


SPACE 

* TRACE IF TRACE FLAG IS SET 
CLI. COMTRFLG,COMTRYES SHALL WE TRACE ? 
BNE ODIS2 NO 


STM  RO,R15,COMTRREG SAVE ALL REGS 

EXEC CICS ENTER TRACEID(2) 

LM RO,R15,COMTRREG RELOAD REGS 
DIS2 EQU * 


E 
DFHEISTG DSECT 
PRINT OFF 
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COPY APICOM 
COPY APIREGS 
PRINT ON 

END 
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B.4.5 APIDIS2 
This is a modification of the original APIDISTR. 


DIST TITLE '*APIDIS2* - BUILD AND SEND A DIA DISTRIBUTE COMMAND - DISO* 
SS API SAMPLE PROGRAMS' 
PRINT NOGEN 

APIDIS2 CSECT a 

KKK KKK IKI KKK IKK KIKI KK KKH KKK IKK HK KEK IKK KK IK KIKI KEK KI KKKKKKKKKHKKKKKKKKKK 

* (APIDIS2) = BUILDS A DIA 'DISTRIBUTE' COMMAND AND PROFILE INFO * 

* THEN SENDS IT TO DISOSS * 

* THIS IS A COPY OF APIDISTR, ADDED FUNCTIONS ARE: * 
* EXPANDED DIU CORRELATION TO 16 BYTES * 
* INPUT PARM LIST: * 
* -> APIDPR (DOCUMENT PROFILE MAP) * 
* -> DIU BUFFER (4K * 
*  QUTPUT: RETURN CODE IN COMRETCD * 
“ 0 COMMAND BUILT AND SENT OK * 
‘ 4 ERROR IN DPR PARAMETERS * 
: 8 BAD RETURN FROM DISOSS. VALUE IN COMREASN : 


KH KKK K IK KK KK I IK KI IKK HK IK KI ICI KK KK IKK KK I IK HICK KK IK KK IKK HI KK I IK Ie I HK He HK 


SPACE 

E R8,4(R1) GET COM ADDRESS 

USING APICOM,R8 

L R9,8(R1) ADDRESS OF DPR MAP 

USING APIDPR,R9 

L R10,12(R1) ADDRESS OF DIU BUFFER 

LR _—-R2, R1O FOR DIU BUILDERS 
HKAKKKKHK KKK KK IKK KK KK KKK KKK KKH KKK KKK KAKI HK KI KA KKK KKKHKKKKHAKKHKKKKKKKKKKK KH 
* HERE WE BUILD THE DIU BASED ON THE DPR INFORMATION * 


KHKKKHK KKK KKK HK K KI KKK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK EKKKKKKKRKKKKKK 


SPACE 
* DIU PREFIX 
LA R1,DPRCOR SET CORRELATION DATA 
LA RO, 16 | CORRELATION LENGTH ALWAYS 16 
BAL R14,DIUPFX BUILD DIU PREFIX 
COMMAND SEQUENCE - ‘DISTRIBUTE! 
LR R4,R2 SAVE ADDR OF CMD SEQUENCE LL 


BAL R14,DISCMD BUILD 'DISTRIBUTE' COMMAND 
IDENTIFIED DATA: DOCUMENT IS IN FIRST DOCUMENT UNIT 

LA RO,1 = 1ST DOC UNIT 

BAL R14, IDDATAI IDENTIFIED DATA (FORMAT 1) 
DESTINATION NODE ADDRESS : 
LA RO,8 ALWAYS LENGTH 8 


* 


*€ 


* 


LA R1 , DPRDDN DESTINATION NODE 
BAL R14, DNADDR 

* ATTRIBUTE LIST, NO COD, NOT PERSONAL, NO PRIORITY, COPIES = 1 
BAL R14 ,ATTLST ATTRIBUTE LIST 


* RECIPIENT NAME | | 
LA RO,8 ALWAYS LENGTH 8 
LA R1,DPRRID ~~ RECIPIENT NAME 
BAL R14,RECADDR 
* SET LENGTH OF COMMAND SEQUENCE SEGMENT 
LR RO,R2 SET CURRENT POINTER 


LR R1,R4 | COLLECT ADDR OF CMD SEQ LL 
SLR RO,R1 SUBTRACT ADDR OF LL 
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STH RO,O(R1) SET CMD SEQUENCE LL 
NOW a DOCUMENT UNIT SEGMENTS 


% 


R4,R2 USE R4 FOR ADDR OF LL 
BAL R14, DUSEGN DOCUMENT UNIT SEGMENT (NOT LAST) 
* SET DOC TYPE AND SYSTEM ID 
LH RO ,DPRDOT SET DOC TYPE AS PASSED 
LA R1,DPRSYS AND SYSTEM ID (IGNORE LENGTHS) 


SET DOC TYPE & SYSTEM ID 
ADDR OF PROFILE LL 


* 


BAL R14, DUSYS 
START OF DOCUMENT PROFILE(S) 
LR R5 ,R2 


BAL R14, PRDOC BUILD DOC PROFILE LLCTF 
* BASE SUBPROFILE 
LR R6,R2 ADDR OF BASE SUBPROFILE LL 
BAL R14,PRBASE BUILD BASE SUBPROFILE LLCTF 
* DOCUMENT TYPE 
LH RO, DPRDOT DOCTYPE AS PASSED 
BAL R14,PRBTYPE SET DOCUMENT TYPE 
* PROFILE GCID 
L RO ,DPRPGC GPID + GCID 
BAL R14,PRBGCID SET PROFILE GCID 


* DOCUMENT GCID 
* DISOSS DOES NOT LOOK AT GCID IN PROFILE 
. BAL R14,DGCID DOCUMENT GCID 215-108 
* DOCUMENT NAME 

LA R1,DPRDON DOCUMENT NAME 

SLR RO,RO 

1G RO, DPRDONL & LENGTH 

R14,PRBDOCN SET DOCUMENT NAME 

* SUBJECT 

LA R1,DPRSUB 

SLR RO, RO 

IC RO, DPRSUBL 

R14, PRBSUBJ SET SUBJECT FIELD 

* AUTHOR 

LA R1, DPRAUT 

SLR RO,RO 

IC RO, DPRAUTL 

BAL R14,PRBAUTH SET AUTHOR VALUE 
* CREATION DATE & TIME 
. BA R14,PRBTIME SET CURRENT DATE AND TIME 


GET CURRENT ADDRESS 

SLR RO,R6 GET LENGTH OF BASE SUBPROF 

STH RO,O(R6) & STORE LENGTH IN LL FIELD 
END OF DOCUMENT PROFILES - SET PROFILE LL 

LR RO,R2 GET CURRENT ADDRESS 

SLR RO,R5 GET LENGTH OF DOC PROFILE 

STH RO,O(R5) & STORE LENGTH IN LL FIELD 
DOCUMENT CONTENT INTRODUCER 


L 
* END OF BASE SUBPROFILE - SET BASE SUBPROFILE LL 
LR RO,R2 


~ 


* 


BAL R14,DCI DCI BUILDER 
* END OF DOC UNIT SEGMENT - SET DOC UNIT LL | 

LR RO,R2 GET CURRENT ADDRESS 

SLR RO ,R4 GET LENGTH OF DOC UNIT 

STH RO,O(R4) & STORE LENGTH IN LL FIELD 
eeeaahn | anew ene cau eee 
* DIU NOW BUILT - SEND IT TO DISOSS ~ | ii 


HICK KK EK KKK RIKI KK KIO KOR RKO ROKK IOI KOK IO kK kk kk KK KK OK 


SPACE 
* TELL DISOSS WHAT WE HAVE 
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ENDCSECT 
DFHEISTG 


SLR 
STH 


R10 ,COMDPTR TELL DISOSS WHERE IT IS 
R2,R10 OBTAIN LENGTH 
R2, COMDLEN TELL DISOSS ALSO 


SPACE 
a ata APIDISOS, (=CL8'SEND' ) 
* WE RETURN WITH THE RETURN CODE FROM DISOSS | 


R15, COMREASN SET REASON CODE AS DISOSS RC. 
R15.R15 WAS IT BAD RC 2 

+8 | NO, USE ZERO AS OUR RC 

R15,8 OTHERWISE WE HAVE RC 8 

R15. COMRETCD 

ENDCSECT BRANCH ROUND STATIC DATA ETC 
APIDIUS2 DIU BUILDER SUBROUTINES 

OH | 

OFF 

APICOM 

APIDPR2 

APIREGS 

ON 


132 Connecting non-DIA Systems to DISOSS 


B.4.6 APIFIL2 
This is a modification of the original APIFILE. 


FILE TITLE '*APIFILE* - BUILD AND SEND A DIA FILE COMMAND - DISOSS API * 
SAMPLE PROGRAMS! 
PRINT NOGEN 

APIFIL2 CSECT 

KHKKIK KKK KKK KH KK KK IKK KKK KKK KKH K IKK KKH KK KKK KKK IKK HH K KKK KIKI K KK KKK KKK KKK 

* (FILE) - BUILDS A 'FILE' COMMAND, PLUS PROFILE INFO * 

* THEN SENDS IT TO DISOSS * 

* COPY OF APIFILE, ADDED ‘ 
* 16 BYTES CORR. DATA * 
* SOURCE ADDRESS, FILE ON BEHALF. . x“ 
* INPUT PARM LIST: * 
‘ -> APIDPR (DOCUMENT PROFILE MAP) “ 
* -> DIU BUFFER (4K) x 
*  QUTPUT: RETURN CODE IN COMRETCD “ 
* 0 COMMAND BUILT AND SENT OK “ 
* 4 ERROR IN DPR PARAMETERS ‘ 
. 8 BAD RETURN FROM DISOSS. VALUE IN COMREASN : 


KKK kok kok kok kK kok kok kok kok kk kk ok kkk ko kok kk Ok kk kok kok kok kK KKK KKK 


SPACE 

L R8,4(R1) 
USING APICOM,R8 
L R9,8(R1) 
tate APIDPR,R9 


GET COM ADDRESS 
ADDRESS OF DPR MAP 


R10,12(R1) ADDRESS OF DIU BUFFER 
LR R2,R10 FOR DIU BUILDERS 
KKKEKKKKKKKK KKK KKK KK kk kkk kk ok tok kok ok kok kok koko kok kok kok kkk KKK Ok kok kK KKK KK KK 
* HERE WE BUILD THE DIU BASED ON THE DPR INFORMATION * 
KHKKKKKKI KI KKK KICK KKK KI KK KK KKK KKK KKK KKK KKK IKKE KI K KKK KH K KKK KKK KK KK KKK KKK 
SPACE 
* DIU PREFIX 
* [As R1,=C'03! SET ADDRESS AND 
* LA —-RO,2 LENGTH OF CORRELATION DATA 
LA —_—-R1, DPRCOR CORRELATION DATA 
LA —- RO, 16 LENGTH OF CORRELATION DATA 
BAL _ R14, DIUPFX BUILD DIU PREFIX 
* COMMAND SEQUENCE - 'FILE! 
LR R42 SAVE ADDR OF CMD SEQUENCE LL 
BAL R14, FILECMD BUILD 'FILE' COMMAND 
* IDENTIFIED DATA: DOCUMENT IS IN FIRST DOCUMENT UNIT 
LA RO, = 1ST DOC UNIT 
BAL _ R14, IDDATA1 IDENTIFIED DATA (FORMAT 1) 
* SOURCE ADDRESS FILE ON BEHALF OF 
LA —-RO,8 SET LENGTH ALWAYS 8 
LA —s-R1, DPRRID RECIPIENT NAME USED AS SOURCE ADRESS 
BAL R14, SRCADDR 
* ACCESS CODE VALUE 
SLR RO, RO CLEAR REG 0 
IC ——- RO, DPRACCL SET LENGTH 
LA —-R1, DPRACC SET ACC CODE VALUE 


BAL R14 ,ACCCODE 
* SET LENGTH OF COMMAND SEQUENCE SEGMENT 
LR RO,R2 SET CURRENT POINTER 
LR R1,R4 COLLECT ADDR OF CMD SEQ LL 
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SLR RO,R1 | SUBTRACT ADDR OF LL 


STH RO,O(R1) SET CMD SEQUENCE LL © 
* NOW START DOCUMENT UNIT SEGMENTS — 
LR R4,R2 USE R4 FOR ADDR OF LL 
BAL R14,DUSEGN DOCUMENT UNIT SEGMENT (NOT LAST) 
* SET DOC TYPE AND SYSTEM ID 
LH RO, DPRDOT SET DOC TYPE AS PASSED 
LA R1,DPRSYS AND SYSTEM ID (IGNORE LENGTHS ) 
BAL R14,DUSYS SET DOC TYPE & SYSTEM ID 
* START OF DOCUMENT PROFILE(S) 
LR R5,R2 ADDR OF PROFILE LL 
BAL R14, PRDOC — BUILD DOC PROFILE LLCTF 
* BASE SUBPROFILE | 
LR R6 ,R2 ADDR OF BASE SUBPROFILE LL 
BAL R14, PRBASE BUILD BASE SUBPROFILE LLCTF 
* DOCUMENT TYPE | 
LH RO, DPRDOT DOCTYPE AS PASSED 
— BAL R14,PRBTYPE | SET DOCUMENT TYPE 
* PROFILE GCID 
2 RO, DPRPGC GPID + GCID 
BAL R14, PRBGCID SET PROFILE GCID '01510100' 
* DOCUMENT GCID | 
* DISOSS DOES NOT LOOK INTO DOC GCID IN PROFILE 
- BAL R14 ,DGCID SET DOCUMENT GCID '00070108' 
* DOCUMENT NAME 
LA Ri, DPRDON DOCUMENT NAME 
SLR RO,RO 
[Cc RO, DPRDONL & LENGTH 
R14, PRBDOCN SET DOCUMENT NAME 
* SUBJECT 
LA R1 , DPRSUB 
SLR RO, RO 
IC RO ,DPRSUBL 
R14, PRBSUBJ SET SUBJECT FIELD 
* AUTHOR 
RI, DPRAUT 
SLR RO,RO 
Ic RO, DPRAUTL 
BAL R14,PRBAUTH SET AUTHOR VALUE 
* CREATION DATE & TIME 7 
: BAL R14,PRBTIME SET CURRENT DATE AND TIME 


* END OF BASE SUBPROFILE - SET BASE SUBPROFILE LL 
LR RO,R2 GET CURRENT ADDRESS 
LK RO, R6 GET LENGTH OF BASE SUBPROF 
STH RO,O(R6) & STORE LENGTH IN LL FIELD 
* END OF DOCUMENT PROFILES - SET PROFILE LL 
LR RO,R2 GET CURRENT ADDRESS 


SLR RO,R5 GET LENGTH OF DOC PROFILE 
STH RO 0(R5) & STORE LENGTH IN LL FIELD 
* DOCUMENT CONTENT INTRODUCER 
BAL R14,DCI DCI BUILDER 
* END OF DOC UNIT SEGMENT - SET DOC UNIT LL 
LR RO,R2 GET CURRENT ADDRESS 
SLR RO,R4 GET LENGTH OF DOC UNIT 
STH RO 0(R4) & STORE LENGTH IN LL FIELD 
fore ee i ACURA INRIA RitwRi été awe 
* DIU NOW BUILT - SEND IT TO DISOSS * 


KKK KK KKK IKKE KIKI KKK KK KKK KEK KKK KI KK HK KI KK KI KKK KK IK IK HK KKK KK IK KK KK IK KKK 
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SPACE 
* TELL DISOSS WHAT WE HAVE 


ST R10,COMDPTR TELL DISOSS WHERE IT IS 
SLR R2,R10 OBTAIN LENGTH 
STH R2,COMDLEN TELL DISOSS ALSO 


SPACE 
a ata APIDISOS, (=CL8'SEND' ) 
* WE ae WITH THE RETURN CODE FROM DISOSS 


R15,COMREASN SET REASON CODE AS DISOSS RC 
LTR R15,R15 WAS IT BAD RC ? 
BZ *+8 NO, USE ZERO AS OUR RC 
LA R15,8 OTHERWISE WE HAVE RC 8 
T R15,COMRETCD 
SPACE 
ices ENDCSECT BRANCH ROUND STATIC DATA ETC 
COPY APIDIUS2 DIU BUILDER SUBROUTINES 
EJECT 


ENDCSECT DS OH 
DFHEISTG DSECT 
PRINT OFF 
COPY APICOM 
COPY APIDPR2 
COPY APIREGS 
PRINT ON 
END 
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B.4.¢ APIGTCMD 


GCMD TITLE '*APIGTCMD* - GET COMMAND && PARMS FROM INPUT DIU - DISOSS A* 
PI SAMPLE PROGRAMS " 
PRINT NOGEN 
APIGTCMD CSECT 


KIKI KI KIKI IK IK IK KK KKK IKK KI III IK KK IK IO IK IK IK II IK II IK IK KKK KK III IO KIKI KKK 


* * 
- » (APIGTCMD) ANALYZES DIU INPUT AND INDICATES COMMAND IN THE i 
. COM BLOCK AND THE PARAMETERS IN THE PASSED DPR BLOCK : 
JOO ICO OO OOOO IOI OI OI OGIO IOC III TOK ICI 

SPACE 

L R8,4(R1) ADDR OF APICOM 

USING APICOM,R8 - 

L R4,8(R1) ADDRESS OF DPR BLOCK 


USING APIDPR,R4 
SPACE 


GETCMD1 EQU * 
* WE PASS ON OUR PASSED 4K DPR BLOCK 
APICALL APIPARSE, (APIDPR) 


SPACE 
LTR R15,R15 MAKE SURE OK. 
BNZ GETCMDR. RETURN IF NOT 
T™M COMDST , COMDSTC HAVE WE GOT COMMAND YET ? 
BZ GETCMD1 NO, TRY FOR NEXT 
GETCMDR EQU * — 
EJECT 
DFHEISTG DSECT 
PRINT OFF 


COPY APICOM 
COPY APIDPR 
COPY APIREGS 
PRINT ON 
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B.4.8 APILAST 


LAST TITLE Mie cue - PERFORM A "LAST" CALL - DISOSS API SAMPLE PROGR* 
A 


PRINT NOGEN 
APILAST CSECT 


KKK IKI KKK KKK KK II KIKI KKK KKK IKK KK KK IKK KKK KKK KK KKK HK KKK KKK KK KKK KK KKK KKK KKK 
* 


+ 


* (LAST), SUBROUTINE TO ISSUE A ‘LAST! CALL TO DISOSS : 
‘ PARNS : 
* NAME OF TRANSACTION THAT DISOSS SHOULD START IN RESPONSE = * 
x 
KIKI HK IKK KI HK KKK IKK HI KKK KK I HK IK HK KIKI KKK KKK KK KKK KKK HKKKKA KK KKK KKK KKK KK KKK 
SPACE 
L —-R8, 4(R1) LOAD APICOM ADDRESS 
USING APICOM, R8 
Log Rae 8CRL) ADDR OF TRANSACTION NAME 
SPAC 
MVC LSTTRAN, 0(R4) RESPONSE TRANSACTION ID 
MVI_LSTFLAG, X' FF 1 RESPONSE TRAN FOR ALL 
MVC _ LSTTERM,EIBTRMID RESPONSE TRAN FOR THIS TERMINAL 
SPAC 
LA RO, LST GET COMMAND DATA 
ST  RO,COMDPTR & TELL DISOSS 
LA RO, LSTLEN GET DATA LENGTH 
STH _ RO,COMDLEN TELL DISOSS 


SPACE 

* NOW CALL DISOSS 
APICALL APIDISOS,(=CL8'LAST' ) 
SPACE 


ST R15, COMREASN SET REASON CODE AS DISOSS RC 

LTR R15,R15 WAS IT BAD RC ? 

BZ *+8 NO, USE ZERO. AS OUR RC 

LA R15,8 OTHERWISE WE HAVE RC 8 

ST R15 ,COMRETCD 

EJECT 
DFHEISTG DSECT 
LST DS OF PARAMETERS FOR "LAST" 
LSTTRAN DS CL4 RESPONSE TRANSACTION ID 
LSTFLAG DS X 1 TRANSACTION PER MSG 
LSTTERM DS CL4 TERMID TO START TRAN AGAINST 
LSTLEN EQU *-LST 

SPACE 

PRINT OFF 


COPY APIREGS 
PRINT ON 
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B.4.9 APIPARSE 


PARS 


* 


"PRINT NOGEN DIU PARSER - DISOSS API SAMPLE PROGRAMS * : 
APIPARSE CSECT 


EO HIOO SI IOS ISIG ISO IOCISOE IOI IDE IORI IIE IOI IIE IOI I TOTTI IO III II IIR III IE 


NOGEN 


ESS) PARSE AN INCOMIMG DIU ELEMENT 


* 
* 
* 
* INPUT: 
* 
* 
* 


HH HK KK KKK KK IK IO I IK KK KICK HK HK II KK I I IOI I KI KKK IK KK KICK KKK KK HK KK IK 


ANDIUO 


| CL 
* AND MAINTAIN 
LH 
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RECEIVE THE NEXT DIU SEGMENT FROM DISOSS IF NECESSARY. 
-> 4K DPR OR TEXT BUFFER TO RECEIVE PARAMETERS OR 


PROFILE OR. DOCUMENT SEGMENT. 


APICOM ADDRESS 


HOLD 4K BLOCK POINTER IN R2 HERE 


LOAD CURRENT ae BUFFER ADDRESS 
DO WE HAVE ONE ? 
P GETMAIN 


YES, SKI 
EXEC CICS GETMAIN SET(R10) LENGTH(8220) 00') 
S STORE IT ESS 


S ADDR 
INITIALIZE ... 
- TOTAL BUFFER LENGTH ~ 
- TOTAL DIU SEGMENT LENGTH 
- AMOUNT OF SEGMENT USED SO FAR 
NO COMMAND AS YET 
STATUS INDETERMINATE 


HAVE WE REACHED END OF DATA ? 
YES, NO MORE TO GET 


~ HOW MUCH IN BUFFER ? 


MORE : 
OTHERWISE GET MORE FROM DISOSS 


CHECK RC 

QO - CARRY ON 

WAS IT END OF DATA ? 

NO, QUIT WITH BAD RETURN 

CLEAR BAD RETURN CODE INDICATOR 
SET END OF DATA FLAG 

AND GO PROCESS. 


GET BUFFER ADDRESS 

INCR TO CURRENT POSITION 
ADDRESS OF INPUT DATA 
SOURCE LENGTH 

TARGET LENGTH = SOURCE 


SPACE 

L ——«R&, 4(R1) 

USING APICOM,R8 

L R2,8(R1) 

USING APIDPR,R2 
SPACE 

L R10 , COMDBUFP 
LTR R10,R10 

BNZ  ANDIUO 

T  _R10,COMDBUFP 
SLR RO, RO 

STH RO, COMLDIU1 
STH RO, COMLDIU2 
STH RO, COMLDIU3 
MVI  COMDCMD,X'00! 
MVI COMDST,X'00' 
SPACE 

EQU* 

TM COMDST, COMDSTE 
BO  ANDIU2- 

LH RO, COMLDIU1 

CH RO, =H'4110! 

BH  ANDIU2 
APICALL APIRECVE 

LTR R15,R15 

BZ  ANDIU1 

CH RO, =H'3! 

BNE  ANDIUR 

XC COMRETCD,COMRETCD 
OI  COMDST,COMDSTE 
B ANDIU2 

a DATA. MOVE IT INTO OUR BUFFER 
LR R4, R10 

AH —_-R4, COMLDIU1 

L R6.COMDPTR 

LH  R7,COMDLEN 

LR —-R5,R7 

MV 


AH 


R4 ,R6 

RECORD OF THIS DATA 
R7 ,COMLDIUI 

R7 , COMDLEN 

R7 , COMLDIU1 


MOVE INPUT DATA 


CURRENT LENGTH 
PLUS NEW LENGTH 
UPDATED 
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* 
* 
* 
x. 
* 
* 
* 
* 


ANDIU2 


ANDIU3 


BXLE 
* DIU C-T BYTE 
LA 


ANCMDCH 


ANPRFCH 


* UPDATE 


ANDIUR1 


ANDIUR 


GET NEXT AS NECESSARY 


DIU ANALYSIS 

POINT AT C-T TABLE 

LENGTH OF TABLE ENTRY 

POINT AT TABLE END 

GET BRANCH ADDRESS 

IS IT THIS TABLE ENTRY ? 

YES, BRANCH TO PROCESSING ROUTINE 
OTHERWISE LOOP FOR NEXT 


INDICATE MAJOR ERROR 
AND RETURN TO CALLER 


COPY LL VALUE FOR ELEMENT 

ADD IN AMOUNT USED 

HAVE WE PROCESSED ALL SEGMENT 
NO, RETURN 

YES, MARK COMMAND COMPLETE 

& RETURN 


COPY LL VALUE FOR ELEMENT 
ADD IN AMOUNT USED 
HAVE WE PROCESSED ALL SEGMENT 


NO, RETURN 
YES, MARK PROFILES COMPLETE 
& RETURN 


THE BUFFER LEFT OVER THE CURRENT ELEMENT 
R4,R10 TARGET AD 


DRESS 
SOURCE ADDRESS 
CURRENT LENGTH 
LESS LL FOR CURRENT ELEMENT 
TARGET LENGTH 
SHIFT LEFT IN BUFFER 


TOTAL LENGTH 

LESS AMOUNT JUST PROCESSED 
UPDATED 

AMOUNT USED IN SEGMENT 

+ ELEMENT JUST PROCESSED 
UPDATED 


DID WE HIT END OF DATA ? 


NO 
YES, SO GET DATA LENGTH 
ANYTHING LEFT ? 


YES 
NO . ADDR OF BUFFER 
CLEAR ADDRESS 


INDICATE GOOD RETURN 


B ANDIUO 

SPACE 

EqU * 

LA —-R4, ANTAB 

LA —R6,8 

LA _—R7, ANTABE-1 

L 5 54(Ra) 

CLC 2(2,R10) ,0(R4) 

BER 5 
R4,R6,ANDIU3 
NOT RECOGNIZED - ERROR 
R15 ,255 

B ANDIUR 

SPACE 2 

DS OOF 

LR —-R4, RO 

AH —-R4, COMLDIU3 

CH -R4, COMLDIU2 

BL ANEND 

OI  COMDST,COMDSTC 

B ANEND 

SPACE 2 

DS OF 

LR —-R4, RO 

AH -R4,, COMLDIU3 

CH -R4, COMLDIU2 

BL ANEND 

OI  COMDST,COMDSTP 

B ANEND 

SPACE 2 
* 

LR 

iA —-R6, O( RO, R4) 

LH —_R7,COMLDIU1 

SLR R7,R9 

LR —RS5.R7 

MVCL R4,R6 

SPACE 

LENGTH POINTERS 

LH R7, COMLDIU1 

SLR R7, 

STH R7,COMLDIU1 

LH —_R7, COMLDIU3 

ALR R7,R9 

STH 7, COMLDIU3 

SPACE 

T™  COMDST, COMDSTE 

BZ  ANDIURI 

LH RO, COMLDIU1 

LTR RO,RO 

BNZ  ANDIURI 

L R10 , COMDBUFP 

EXEC CICS FREEMAIN DATA(0(R10)) 

XC COMDBUFP , COMDBUEFP 

EQU* 

SLR R15,R15 

SPACE 

EQU* 
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STM  RO,R15,COMTRREG 
EXEC CICS ENTER TRACEID(7) 
LM RO,R15,COMTRREG 


ST  RO,COMREASN SET OUR REASON CODE 
ST  R15,COMRETCD AND OUR CALCULATED RC 
B __ ENDCSECT _ FINISHED 
aeeeeahek 2 a eaene Rene ene ERAS aR Ae 
* * 
*  (ANXX) DIU ANALYSIS ROUTINES, REACHED BY BRANCH TABLE * 
JOR OOO OOOO IO O OOOO IO IOI IOI IOI III III IO ICICI IOI ICICI IOC I 
SPACE 
* PREFIX 
ANIO.  EQU * 
MVI  COMDCMD,X'00' CLEAR COMMAND BYTE 
NI COMDST , 255-(COMDSTC+COMDSTP+COMDSTD+COMDSTX) 
LH R9,0(R10) GET LL VALUE 
B _ANEND BUMP AND CHECK LENGTH 
* SUFFIX a 
ANI]  EQU * 
OI  COMDST,COMDSTX SHOW SUFFIX FOUND 
LH R9, 0(R10) SO WE CLEANLY HAVE ZERO LENGTH 
B __ANEND GO SCHEDULE DISOSS 


SPACE 2 
* DELIVER COMMAND 
AN15 EQU  * 
MVI = COMDCMD,COMDDLV INDICATE THIS IS DELIVER 
B ANSTCMD SETUP FOR START OF COMMAND 
* ACKNOWLEDGE COMMAND 
AN16 EQU  * 
MVI = COMDCMD ,COMDACK INDICATE THIS IS ACK 
B ANSTCMD SETUP FOR START OF COMMAND 


* SIGNON RESPONSE 
AN17 EQU * 


MVI = COMDCMD , COMDSON INDICATE THIS IS SIGNON RESPONSE 

ate epee SETUP FOR START OF COMMAND 
ANSTCMD EQU * START OF COMMAND SEGMENT 

SLR RO,RO 

STH  RO,COMLDIU3 NOTHING USED IN SEGMENT SO FAR 

LH R9,O0(R10) GET COMMAND UNIT LENGTH 

STH  R9,COMLDIU2 SO WE KNOW WHEN END OF COMMAND 

LA R9,5 JUST 5 FOR COMMAND 

veer ANEND BUMP AND CHECK LENGTH 


* THE FOLLOWING COMMAND OPERANDS WE IGNORE, EXCEPT THAT WE CHECK 
* TO SEE IF Ms COMMAND OPERANDS ARE COMPLETE 


SPA 
AN20 EQU * IDENTIFIED DATA 
AN2] EQU * CORRELATION 
AN24 EQU  * ATTRIBUTE LIST 
AN25 EQU * RECIPIENT NAME (WE KNOW IT) 
AN40 EQU  * FUNCTION SETS 
AN41 EQU * SIGNON REPLY 
LH R9 ,O(R10) LL VALUE 
ieee ANCMDCH CHECK COMMAND COMPLETE 


* THE FOLLOWING ARE PROFILE INTRODUCERS, SO WE JUST SKIP 
* OVER THE LLCTF 
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R9,5 
B ANPRFCH 
SPACE 


PROFILE INTRODUCER 

BASE SUBPROFILE | 

APPLICATION SUBPROFILE 

5 ONLY, FOR LLCTF 

CHECK TO SEE IF PROFILES COMPLETE 


* MANY OF THE DIU OPERANDS WE IGNORE, SO WE GROUP THESE 


* TOGETHER AS 'NULL ACTION' 
SPAC 


AN54 = EQU. * 3730 SUBPROFILE 
AN5S5 EQU * DISOSS SUBPROFILE 
ANS6 EQU * 5520 SUBPROFILE 
AN6O =©EQU * DOCUMENT NAME 
AN62 FQU * OWNER 
AN63 EQU* AUTHOR 
AN64 EQU * DOCUMENT GCID 
AN6S  EQU * DOCUMNT TYPE 
AN66 EQU * CREATE DATE/TIME 
AN67 FQU * LAST CHANGED DATE 
AN68 EQU * COPY LIST 
AN69 EQU* FILE CABINET REF 
AN70 EQU * SUBJECT 
AN71 FQU * SYSTEM CODE 
AN72  EQU * DOCUMENT SIZE 
AN74  EQU. * DOCUMENT CLASS 
AN75  EQU * DOCUMENT DATE 
AN76  EQU * LEVEL 3 PARAMETER SET 
AN8O = EQU * FILE DATE/TIME 
AN81 FQU * OWNERSHIP 
AN82  EQU * KEYWORDS 
AN83 EQU-* EXPIRY DATE 
AN84  EQU-* OWNER DELEGATE 
AN91 FQU  * DOCUMENT CONTENT PROFILES ONLY 
AN9O FOU * DOCUMENT CONTENT WITH TEXT 

LH R9,0(R10) LL VALUE 

B _ANPRFCH CHECK TO SEE IF PROFILES COMPLETE 
see Raed a eee Ee ete es eee 
* * 
* HERE WE PROCESS THOSE OPERANDS THAT MEAN SOMETHING TO US : 


KKKEKKKKKKKKKK KKK KKK KKK KK KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KKKKKKEKKKKKKEKKKKE 


SPACE 
* SOURCE NAME 


AN22 EQU 
LH —-R9,0(R10) 
LR ——-R5.RO 
S R5.=F'6! 


EX RS ,MVDLVUSR 
B ANCMDCH 

MVDLVUSR MVC = DPRSID(1) ,5(R10) 
SPACE 

* DOC DISTRIBUTION NAME 

AN23 EGU. 2 


R9,0(R10) 
MVC DPRDIS,5(R10) 
B ANCMDCH 


COLLECT LL VALUE 

COPY LL VALUE 

5 FOR LLCTF + 1 FOR EXECUTE 
PUT IN DPR AREA 


COPY SOURCE NAME 


COLLECT LL VALUE 


PUT IN OUT MAP 
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SPACE” | 
* SOURCE ADDRESS (LOCATION) 


AN26 EQU | _ 
LH R9,0(R10) | COLLECT LL VALUE 
LR R5,R9 
S R5,=F'6' 5 FOR LLCTF + 1 FOR EXECUTE 
EX R5 ,MVDLVLOC PUT IN OUT MAP 
ANCMDC 7 


B H 
MVDLVLOC SpiGE DPRDDN(1),5(R10) 
* MESSAGE (IF DOC WAS DISTRIBUTED FROM LIBRARY BY ONLINE USER) 
AN27 EQU * 


R9,O(R10) | | COLLECT LL VALUE 
LR R5,R9 
S R5,=F'6' 5 FOR LLCTF + 1 FOR EXECUTE 
EX RS ,MVOLVMSG PUT IN DPR BLOCK 
LA 5,1(R5) PUT BACK 1 FOR EXECUTE 
STC  R5,DPRMSGL SET LENGTH IN MAP 


B ANCMDCH 
MVDLVMSG MVC = DPRMSG(1) ,5( R10) 
SPACE 
* EXCEPTION CODE 
AN30 EQU  * 


MVC DPREXCOD,5(R10) COPY EXCEPTION CODE 
LH R9,0( R10) LL VALUE 
eoKeE ANCMDCH CHECK FOR COMMAND PARMS COMPLETE 


* REPLY DATA 
AN31 EQU  * 


‘LH R9,0(R10) LL VALUE 
LR 5 RO | 
S R5 =F'6! 5 FOR LLCTF + 1 FOR EXECUTE 
EX —-R5, AN31MVC PUT IN DPR BLOCK 

AN CHECK FOR COMMAND COMPLETE 


B CMDCH 

AN3IMVC MVC  DPRACKR(1),5(R10) 
EJECT 

* PROFILE GCID 


AN61 EQU 
LH R9,OC R10) LL VALUE 
MVC = DPRPGC,5(R10) COPY PROFILE GCID FOR REFILE 
Same ANPRFCH CHECK FOR PROFILE COMPLETE 
* LADN PROFILE OPERAND 
AN73 EQU  * 
LH R9,O( R10) LL VALUE 
MVC =DPRLAD,7(R10) COPY DTM PART OF LADN 
ae ANPRFCH CHECK FOR PROFILE COMPLETE 
* TEXT SEGMENT INTRODUCER 
AN95 EQU* : 
LH R9,O(R10) LL VALUE 
T™M COMDST , COMDSTP HAVE WE HAD PROFILES ? 
BO AN9SA YES, PROCESS TEXT 
STH R9,COMLDIU2 © NO, SET SEGMENT LENGTH 
SLR RO,RO INITIALIZE ... 
STH RO,COMLDIU3 .. LENGTH USED 
MVC DPRDOT,8(R10) COPY DOC TYPE 
MVC =©DPRSYS,10(R10) AND SYSTEM CODE 
LA R9,23 INCR FOR LLCTF, ISS, TYPE & CODE 


B ANPRFCH CHECK FOR PROFILE COMPLETE 
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SPACE 
ANQSA EQU * 


* IF Pea. LAST TEXT SEGMENT, MARK TEXT BUFFER ee AND QUIT 


5(R10), X'20! 
BZ  AN95C 
SPACE 
* WILL SEGMENT FIT IN BUFFER ? 
LR ——-R7,R9 
SH —_—R7,=H'8! 
LR R17 
LH RO, =H' 4088! 
SH RO, O(R2) 
CR ——-RO,R7 
BL  AN95B 
SPACE 
* YES, THERE IS SPACE IN BUFFER 
LH ——-R5, 0(R2) 


LA —-R4,8(R5,R2) 
LA —-R6,8( R10) 
LR —R5,RI 
MVCL R4,R6 
SPACE 

* AND UPDATE BUFFER USE VALUES 
AH -R1,0(R2 
STH R10 R2 
B ANOSR 
SPACE 

AN95B =séEQU-C* 


LAST SEGMENT ? 
YES, FINISH 


ELEMENT LENGTH | 
REDUCE FOR LLCTF AND ISS 
COPY LENGTH FOR LATER 

MAX DATA IN BLOCK 
CALCULATE SPACE AVAILABLE 
COMPARE AGAINST THIS BLOCK 
TOO MUCH, WE MUST SPLIT IT 


GET CURRENT LENGTH 
TARGET ADDRESS 
SOURCE ADDRESS 
TARGET LENGTH 
MOVE TEXT SEGMENT 


NEW LENGTH + OLD LENGTH 
UPDATED 


* THERE WAS NOT ENOUGH SPACE IN BUFFER 
* RO = SPACE AVAILABLE R1 = LENGTH OF DATA 


SPACE 

* MOVE AS MUCH AS WILL FIT 
LR —-R7,RO 
LH —-R5, O(R2) 
LA —_—-R4,8(R5,R2) 
LA _-R6, 8(R10) 
LR 5 RI 
MVCL R4,R6 


USE SPACE AVAILABLE 
GET CURRENT LENGTH 
TARGET ADDRESS 
SOURCE ADDRESS 
TARGET LENGTH 

MOVE TEXT SEGMENT 


SPACE 
* WE SET A NEW ELEMENT LENGTH COUNT TO REFLECT THE PSEUDO LLCTF 


* CREATED BELOW 
LR RI, RO 


SPACE 


LENGTH OF TEXT MOVED 
+ 8 FOR THE LLCTFISS 
“8 FOR THE LLCTF WE OVERLAY 


* NOW WE CREATE AN ARTIFICIAL LLCTF OVER THE LAST 8 BYTES OF THE 


* 


TEXT ae “eae ee 


COPY LENGTH MOVED 
8 BYTES B4 END OF TEXT MOVED 
Rl HAS RESIDUAL LENGTH 
+ 8 FOR LLCTFISS 
VALUE 


STORE LL 
MVC 2(6, R4) ,=X'C90381200000' AND CREATE CTFISS 


R —_—-R4,R 
LAs R4 Cra, R10) 
SLR RILR 
LAs RI 5 Rl 
STH R1,00R4 
SPACE 
* AND UPDATE BUFFER USE VALUES 
AH RO, O(R2 
STH RO, OR2 


SPACE © 
AN95C EQU  * 
O] COMDST , COMDSTD 


NEW LENGTH + OLD LENGTH 
UPDATED 


OUR BUFFER IS FULL 
DOC SEGMENT EXISTS 
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S 
AN95R EQU * 


B ANEND 

SPACE 

DROP R2 

EJECT | 
SOI IIIS II IOI I ITI I TOT ISI I TO IIE TT IIIT TT I IIIT I III III I II III II I IIIA 
* * 
. (ANTAB) TABLE OF VALID CTF VALUES AND PROCESSING ADDRESSES | 


FOO IOI III III II III IO IOI IO III II IOI IOI III III III Ie ae 


ANTAB DS ~— OD ALIGN NICELY 7 
DC = =§=Xx'Co01',Xx' own ANAS PREFIX 
DC X'CFOL', -< 0000' ,A ACANLT3 SUFFIX 
* COMMANDS 


DC X'C119' ,X'0000' ,A(AN15 DELIVER COMMAND 
DC X'C101', x! 0000' ,A(AN16 ACKNOWLEDGE COMMAND 
DC X'C10C', x! 0000' 5A ACANI7 SIGNON REPLY — 
* COMMON COMMAND OPERANDS | 
DC X'C520' ,X'0000',A APANDI IDENTIFIED DATA 
DC X'C328', x! 0000',A RAND CORRELATION 
* COMMAND OPERANDS FOR’ DELIVER 
DC SOURCE NAME 
DOC DISTN NAME 


X'C323' ,X'0000' ,A(AN22 
DC X'C305', ,X'0000! A AN24 ATTRIBUTE LIST 


DC X'C306', ,X'0000! A AN25 
DC X'C311', X'0000! A AN26 


DC X'C340', 'X'0000! A AN23 
RECIPIENT NAME 


ORIGIN NODE ID 


DC "C320. ,X'9000! A AN27 MESSAGE 
* COMMAND OPERANDS FOR “ACKNOWLEDGE 
DC X'C322' ,X'0000' at AN30 EXCEPTION CODE 
DC X'C345', ,X'0000! ey AN31 REPLY DATA 
* COMMAND OPERANDS FOR’ SIGNON REPLY 
DC X'C312', X'0000' ,A APANAS FUNCTION SETS 
X'C30D', ,X'0000' 5A AANA 1 SIGNON ID 


DC 

* DOCUMENT PROFILES 
DC X'CA03' ,X'0000' ,A(ANS1 
DC X'CA04' , ,X'0000! A AN52 
DC X'CAQ5' xX! 0000' A AN53 
DC X'CA7O', ,X'0000! A AN54 
DC X'CA71', ,X'0000! A AN55 
DC X'CA72! x! 0000' A AN56 

* BASE SUBPROFILE OPERANDS 


PROFILE INTRODUCER 

BASE SUBPROFILE 
APPLICATION SUB PROFILE 
3730 SUBPROFILE 

DISOSS SUBPROFILE 

5520 SUBPROFILE 


DC X'C700' ,X'0000' ,A(AN60 DOCUMENT NAME 

DC X'C701' ,X'0000' A AN61 PROFILE GCID 

DC X'C702', ,X'0000! A AN62 OWNER 

DC X'C704' }X'0000! 5A AN63 AUTHOR 

DC X'C705' ,X'0000' ,A(AN64 DOCUMENT GCID > 
DC X'C706' ,X'0000' ,A(AN65 DOCUMENT TYPE 

DC X'C707' ,X'0000' ,A( AN66 CREATE DATE/TIME 
DC X'C708' ,X'0000' ,A(AN67 LAST CHANGED DATE — 
DC X'C709' ,X'0000' ,A(AN68 COPY LIST 

DC X'C70A" »X' 0000" ,A AN69 FILE CABINET REF 
DC X'C70B! ,X'0000' ,A(AN70 SUBJECT 

DC X'C70C' xX! 0000' “A AN71 _ SYSTEM CODE 

DC X'C70D', ,X'0000! A AN72 DOCUEMNT SIZE 

DC X'C720' x! 0000' “A AN73 LADN 

DC KR’ C/2l ,X'0000! “A AN74 DOCUMENT CLASS 
DC x C236', ,X'0000! “A AN75 DOCUMENT DATE 

DC 770' x! 0000' “A AN76) 


* APPLICATION SUBPROFILE (DLS) 
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LEVEL 3 PARAMETER SET © 
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~ ANTABE 


DC -X'C740' ,X'0000' ,A(AN8O 

DC = X'€741' ,X'0000' | A(AN81 

DC = X'€742' /X'0000' , A AN82 

DC  X'C744' X'0000' . A(AN83 

DC —- X'€745' .X'0000' , A(AN84 
* DOCUMENT CONTENT INTRODUCERS 

DC pave nea ennaee 

DC  X'CBO2',X'0000' | A(AN91 
* DOCUMENT CONTENT SEGMENTS 

DC = X'€903' ,X''0000!' , A(AN95) 

SPACE 


EQU 
ANTABN EQU (*-ANTAB)/8 
EJECT 


ENDCSECT DS OH 
DFHEISTG DSECT 
PRINT OFF 
COPY APICOM 
COPY APIDPR 
COPY APIREGS | 
PRINT ON 
END 


FILE DATE/TIME 
OWNERSHIP 
KEYWORDS 
EXPIRY DATE 
OWNER DELEGATE 


DOC CONTENT WITH TEXT 
DOC CONTENT WITH PROF 


SEGMENT INTRODUCER 


NUMBER OF TABLE ENTRIES 
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B.4.10 APIPTDOC 


PDOC TITLE '*APIPTDOC* - SENDS A DOCUMENT DIU SEGMENT - DISOSS API SAMP* 
LE PROGRAMS' 
PRINT NOGEN 
APIPTDOC CSECT 


IOI SIO GOI OOS GOGO OGIO GIGI GIOIOI ISIS OIG OISIOISISIOISIOIGIGI ICICI I III I IK 


* * 
* — (APIPTDOC) TAKES A PASSED BUFFER FULL OF DATA (MAX LENGTH IS ‘ 
- 4088 BYTES). BUILDS A DIU TEXT SEGMENT INTRODUCER © e 
AND SENDS THE DIU SEGMENT TO DISOSS . = 
. IF THE LENGTH IS ZERO THEN THIS IS A ‘LAST SEGMENT' i 
AND A NULL LAST SEGMENT IS BUILT AND SENT 
* INPUT PARMLIST: . 
: -> TEXT RECORD . 
” -> TEXT LENGTH (HALFWORD) ™ 
: -> BUFFER TO BUILD DIU IN : 
. OUTPUT: COMRETCD HAS RETURN CODE ; 
* 0 = GOOD RETURN m 
8 = BAD RETURN FROM DISOSS. COMREASN HAS DISOSS RC 
KIKI KKK I KH IK HK HH KK HK KKH KK KK KK IKK IK IH KKK HI KKK KKK KKK IKK IK KKK KK KKK KKK KKK KK KK 

SPACE 

L R8,4(R1) GET APICOM ADDRESS 

USING APICOM,R8 

L R2, 16(R1) GET BUFFER ADDRESS 

L R4 -8(R1) GET TEXT ADDRESS 

L R5,12(R1) GET ADDR OF TEXT LENGTH 

LH RS “0(R5) GET TEXT LENGTH ITSELF 

LR RI ,R2 REMEMBER BUFFER START 

LR R10,R5 & TEXT LENGTH (DESTROYED BY MVCL) 

SPACE 

LTR R5S,RS5 ANY TEXT ? 

BNZ  PTDOCI YES, BUILD FULL DIU 

SPACE 
* ITS A 'LAST SEGMENT! CALL 

BAL R14,DUSEGL BUILD NULL LAST SEGMENT 

B PTDOC2 

SPACE 
* ITS A NORMAL CALL TO BUILD A SEGMENT WITH TEXT 
PTDOC] at . 

R14 ,DUSEGN DOC UNIT SEGMENT (NOT LAST) 


* MOVE TEXT “FOLLOWING DIU SEGMENT INTRODUCER 
* R4 -> TEXT. RS = LENGTH. SET UP ON ENTRY (R10 = LENGTH ALSO) 


LR R6,R2 TARGET ADDRESS 

LR R7,R5 = SOURCE LENGTH, ZERO PAD 
MVCL R6,R4 MOVE TO BUFFER 

ae R2,0(R10,R2) INCREMENT DIU POINTER 


* SET VALUES FOR DISOSS 
PTDOC2 a . 


RQ, COMDPTR TELL DISOSS WHERE IS DATA 
SLR R2,R9 GET DATA LENGTH 

STH R2,COMDLEN - TELL DISOSS 

STH R2,0(R9) SET LL VALUE 


| SPACE 
* CALL DISOSS 


146 Connecting non-DIA Systems to DISOSS 


ENDCSECT 
DFHEISTG 


cone?” APIDISOS, (=CL8'SEND' ) 
* WE RETURN WITH THE RETURN CODE FROM DISOSS 
DISOSS RC 


R4, COMRETCD 
R15 ,COMREASN 
R15,R15 

*+8 


R15,8 
R15 ,COMRETCD 
ENDCSECT 


APIDIUSB 


DISOSS RC IS OUR REASON CODE 
IS IT OK ? 

YES, USE ZERO VALUE AS OUR RC 
NO, WE QUIT WITH RC=8 

STORE RETURN CODE 

BRANCH ROUND STATIC DATA ETC 


DIU BUILDER SUBROUTINES 
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B.4.11 APIPURGE 


PURG TITLE '*APIPURGE* - PURGE ALL API QUEUED DATA FOR USER ~ DISOSS AP* 
I SAMPLE PROGRAMS ' 
PRINT NOGEN 
APIPURGE CSECT 


FHKIKK KIKI KKK KI KKK IKK KKK IK IK KKK KKK KKK KKK KKK KKK IK KKK KI KK KKK KKK KKK KK KK IK KK 


* * 
* — SUBROUTINE TO DO A DISOSS 'PURGE' FOR ALL DATA ASSOCIATED WITH * 
* THE USER * 
* x |. 
* INPUT: USER NAME (8 BYTES) : 
KHKKKKKKKEKKKKKK KKK KK RKO OK IO OKO OO kK kk kok ok kok kk ok kk Kk kK 

SPACE 

L R8 ,4(R1) LOAD APICOM ADDRESS 

USING APICOM,R8 | 

Ssage R9,8(R1) LOAD ADDRESS OF NAME 

MVC =PRGNAME ,0(RI) ~ MOVE IN USER NAME 

MVI  PRGOPT, C'A' ALL OF IT 

LA RO ,PRG GET COMMAND DATA 

ST RO,COMDPTR & TELL DISOSS 

LA RO,PRGLEN GET DATA LENGTH 

STH RO, COMDLEN TELL DISOSS 


SPACE 
* NOW CALL DISOSS 
aa APIDISOS ,(=CL8'PURGE' ) 


R15, COMREASN SET REASON ee AS DISOSS RC 
LTR R15,R15 WAS IT BAD RC ? | 
BZ *+8 NO, USE ZERO AS OUR RC 
LA R15,8 OTHERWISE WE HAVE RC 8 
ST R15, COMRETCD 
EJECT 
DFHEISTG DSECT 
PRG DS OF 
PRGNAME DS CL8 NAME TO PURGE 
PRGOPT ODS C PURGE OPTION 
PRGLEN EQU = *-PRG 
SPACE 
PRINT OFF 


COPY APIDPR 
COPY APIREGS 
PRINT ON 
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B.4.12 APIRECVE 


RECV TITLE '*APIRECVE* - RECEIVE A RESPONSE DIU SEGMENT - DISOSS API SA* 
MPLE PROGRAMS ' 
PRINT NOGEN 
APITRECVE CSECT 


KK IKK KIKI KKK I IK IKK KK HK IK KKK KKK IK KKK KKK KKK KKK KKK KKK KK KKK KK KKK KK KKK KKK KICK 


* * 
(RECEIVE) SUBROUTINE TO RECEIVE A RESPONSE FROM DISOSS * 
* 

JOGO IOI OO IG III IOI IGG III OOOO III III III IOI III III IOI ICR OIIICIO I 

SPACE 

L R8,4(R1) 

USING APICOM,R8 

SPACE 


* NOW CALL DISOSS 
APICALL APIDISOS,(=CL8'RECEIVE' ) 


SPACE 
* CHECK ON DISOSS RC 
ST R15, COMREASN SET REASON CODE AS DISOSS RC 
LTR R15,R15 WAS IT BAD RC ? 
BZ *+8 “NO, USE ZERO AS OUR RC 
LA R15,8 | OTHERWISE WE HAVE RC 8 
ST R15, COMRETCD 
EJECT 
DFHEISTG DSECT 
PRINT OFF 


COPY APIREGS 
PRINT ON | 


API and DIU-build Subroutines 


149 


B.4.13 APIRTRVE | 


RTRV TITLE '*APIRTRVE* - RETRIEVE CICS "START" DATA - DISOSS API SAMPLE* 
| PROGRAMS! oo 


PRINT NOGEN 
APIRTRVE CSECT 


FEF HK FH HIKE KH IK HHH HH HK IKK IK HK HK HK KH HK HK KK HK HI KK IK KK KICK HK HHH KKK KKK KK KKK KKK KKK 


* * 
* (RETRIEVE) - SUBROUTINE TO PICK UP CICS ‘START! DATA * 
* “ON RETURN COMDPTR -> RETURNED DATA 
‘ COMDLEN = LENGTH OF DATA * 
KKK FHKE K HF KH KIKI KKK HI KI KIKI KK IKK IKK KICK HK IK KKH HK IK KIKI KK HHH KICK KK HKHKKKKKKRKKKEK 

SPACE 

L _—R8, 4(R1) 

USING APICOM,R8 

SPACE 


EXEC CICS HANDLE CONDITION ENDDATA( RETRO) 
MVC COMDLEN ,=AL2(100) ARBITRARY MAX VALUE (NEED 36) 
EXEC CICS RETRIEVE SET(R5) LENGTH(COMDLEN ) 


ST R5,COMDPTR SET DATA POINTER FOR CALLER 

B RETRI OK, SET RC VALS 
RETRO EQU * 

SLR RO,RO 

STH RO, , COMDLEN INDICATE NO START DATA 
RETRI EQU 

EXEC CICS HANDLE CONDITION ENDDATA 

SLR R1I5,R15 | 

ST R15, COMRETCD SET ZERO RETURN CODE 

EJECT 
DFHEISTG DSECT 

PRINT OFF 


COPY APICOM 
COPY APIDPR 
COPY APIREGS 
PRINT ON 

END 
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B.4.14 APISGNON 


SON TITLE ee al - PERFORM API SIGNON - DISOSS API SAMPLE PROGRAM* 


PRINT NOGEN 
APISGNON CSECT 


KHKHKHKI KI K KKK KKK IKK KKK KKK KK KKK KKK IKEA KKK KKK KKK KH KK KK KKK HK KKK KI K KKK KK AK 


* (SIGNON) - BUILDS A 'SIGNON' DIU s 
KIKI KK IK KK KKK HK KKK KK KKK KKK KKK IK KKK KEK IKK IK KK KKK KKK KI KK HKKKKKKKEKKKKK KKK 
SPACE 
L R8,4(R1) APICOM ADDRESS 
USING APICOM,R8 
L R2,8(R1) DIU BUFFER ADDRESS 
LR RI, R2 
L R5,12(R1) ADDRESS SIGNON PARMS 
SPACE 
* DIU PREFIX 
LA R1,=C'01' SET ADDRESS AND 
LA RO,2 LENGTH OF CORRELATION DATA 


BAL R14 ,DIUPFX BUILD DIU PREFIX 
* COMMAND SEQUENCE - 'SIGNON' 
LR R6,R2 SAVE ADDR OF CMD SEQUENCE LL 


BAL R14, SONCMD BUILD 'SIGNON' COMMAND 
* FUNCTION SETS: WE TAKE ALL SOURCE/RECIPIENT FS 
LA R1 ,=X'02000202000402000502000802000902000A' 
SE 


LA RO,18 FUNC , 4, 5, 8, 9, 10 
BAL R14, FUNCSETS INDICATE WHICH FUNCTION SETS 
* SIGNON ID 
LA R1,4(R5) SIGNON NAME 
IC RO,2(R5) LENGTH OF NAME 
BAL R14, SONNAME SET NAME 
* SIGNON PASSWORD 
LA ,12(R5) SIGNON PASSWORD 
SLR RO 
IC RO,3(R5) LENGTH OF PASSWORD 
LTR —- RO, RO IS THERE A PASSWORD ? 
BZ SIGNON1 NO, SKIP PASSWORD 
BAL R14, SONPASS SET PASSWORD 
SIGNON] EQU* 
x TYPE OF DOCUMENTS TO BE RECEIVED 
LH RO,0(RS5) DOC TYPE. 
LTR —-RO,RO ANY TYPE SPECIFIED ? 
BZ SIGNON2 NO, SKIP DOC TYPE 
BAL R14, RCVDOCS SET DOC TYPES TO RECEIVE 
SIGNON2 EQU* 
* SET LENGTH OF COMMAND SEQUENCE SEGMENT 
LR RO, R2 SET CURRENT POINTER 
SLR —- RO, R6 SUBTRACT ADDR OF CMD SEQ LL 
STH RO, O(R6) SET CMD SEQUENCE LL 
* SET DIU SUFFIX 
BAL R14, DIUSFX BUILD DIU SUFFIX 
EJECT 
* SET PARMS FOR DISOSS CALL 
ST 9 ,COMDPTR TELL DISOSS WHERE IT IS 
SLR ——-R2,, RO OBTAIN LENGTH 
STH : R2.COMDLEN TELL DISOSS ALSO 


SPAC 
* NOW CALL DISOSS 
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SPA 
* CHECK ON DISOSS RC 
— ST R15,COMREASN - 


oe APIDISOS,(=CL8'BIND' ) 


LTR R15,R15 


ENDCSECT 
DFHEISTG 


BZ *+8 

LA R15,8 

ST R15,COMRETCD 
B ENDCSECT 
EJECT 


COPY APIDIUSB 
DS OH 


PRINT OFF 
COPY APICOM 
COPY APIDPR 
COPY APIREGS 
PRINT ON 


SET REASON CODE 


WAS IT BAD RC ? | 
NO, USE ZERO AS OUR RC 
OTHERWISE WE HAVE RC 8 
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B.4.15 APISNOFF 


SOFF TITLE '*APISNOFF* - PERFORM DISOSS API SIGNOFF - DISOSS API SAMPLE* 
PROGRAMS ' 


PRINT NOGEN 
APISNOFF CSECT 


HHI KKK KKK IKK KI KK I KKK HK KK IK KKK KH IH K KKH KK KKK KK KKK KKH HHH KKK KKK KKK IK KKK KK KK 


* — (SIGNOFF) 7 
* SUBROUTINE TO SIGN OFF FROM DISOSS . 
KKK K KKK KKK KI KKK KKH KKK HK KIKI KKK KKK KKK KKK KK IKK KKK KKK KKK IK KKK KKK IK KKK IK KK 

SPACE 

L R8,4(R1) APICOM ADDRESS 

USING APICOM,R8 

SPACE 

LA RO, SNOFF GET COMMAND DATA 

ST RO ,COMDPTR & TELL DISOSS 

LA RO, SNOFFL GET DATA LENGTH 

STH RO,COMDLEN TELL DISOSS 


* NOW CALL. DISOSS 
eee APIDISOS, (=CL8'UNBIND' ) 


5 
* CHECK ae RC 


R15, COMREASN SET REASON CODE FROM DISOSS RC 

LTR R15,R15 WAS IT BAD RC ? 

BZ *+8 NO, USE ZERO AS OUR RC 

LA ——-R15,8 OTHERWISE WE HAVE RC 8 

ST  R15,COMRETCD 

B ___ ENDCSECT BRANCH ROUND STATIC DATA ETC 
KEKE KK KKK KH K KKK KKK IKK KKH KKK KIKI KKK IKK HK KKK KK HHH HK KK KK KKEKKKIKKKKK KKK KKK KK 
* * 
* THIS IS THE SIGNOFF DIU : 
KKK IK HK KH KKK KKK KK IK KK IKK KKH IKK HH KI HK KI KKH HK KK IK KKK IKK KH KKK KKKKKKKK KKK KKK KK 

SPACE 


SNOFF DC X'0007' ,X'C00102' ,C'04' 
DC X'0005' ,X'CDODO1' 
DC X'0005' ,X'CFO100' 
SNOFFL ETE *= SNOFF 


ENDCSECT DS OH 
DFHEISTG ae 
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B.4.16 APISUFIX. 


SUFX TITLE '*APISUFIX* - SEND A DIU SUFFIX TO DISOSS - DISOSS API SAMPL* 
E PROGRAMS' | : , : OG 


PRINT NOGEN 
APISUFIX CSECT 


KHKKIKKKI KKK HK HK KKK KR HK KI KKK KICK KKK KK KKH I KIKI KK KKK HHI KKE HK KHKKKKKEKKKKKKKK KKK 


* * 
: (SUFFIX) SUBROUTINE TO SEND A STANDARD SUFFIX. © 7 
ELLE RA NARS A SEAR AAASR ARENA EERE ADRIAN RISC ERAEEA EIA TERR 

L R8,4(R1) APICOM ADDRESS 

USING APICOM, R8 | 

SPACE 

LA RO,SUFI GET COMMAND DATA 

ST RO ,COMDPTR & TELL DISOSS 

LA RO, ,SUFIL GET DATA LENGTH 

ae RO, COMDLEN TELL DISOSS 


SPACE 
* NOW CALL DISOSS 
eOhEET APIDISOS ,(=CL8'SEND' ) 


SP 
* CHECK ee ee RC 


R15,COMREASN SET REASON nea FROM DISOSS RC 
LTR R15,R15 WAS IT BAD RC ? 
BZ *+8 NO, USE ZERO AS OUR RC 
LA R15,8 OTHERWISE WE HAVE RC 8 
ST R15,COMRETCD 
ENDCSECT BRANCH ROUND STATIC DATA ETC 
KKKKHKK KKK KKK IK KKK KKK KI KKK IKI KKK IK HI KKK KKKKK KK KKKE KKK IKE KI KKKKKKKKKKKKKKK 
* THIS IS THE STANDARD SUFFIX DATA . 
KHIKKHKKIKKHK KK IKK KK KKK KKK KKK IKK KKK HI KKK KKK KIKI KKK IKK HK IK HK HKKKKK IK KKKKKK 
SPACE 7 
SUF] DC AL2(5) ,X'CFO100' DIU SUFFIX 
SUFIL EQU = *-SUFI 
EJECT 


ENDCSECT DS OH 
DFHEISTG DSECT 
PRINT OFF 
COPY APICOM 
COPY APIDPR 
COPY APIREGS 
PRINT ON 


154 Connecting non-DIA Systems to DISOSS 


C.0 SAMPLE EXECS FOR THE CMS AND PROFS USER 


C.1 SAMPLE DBTMENU EXEC 


&TRACE OFF 


HHH KK IKI KK IKI KIKI HK II HK IK KH IKK KKK KH KI KKK KK KKK HK KKK KKKKKKKEKKKEKKKKKKK KKK KK IKK 


* Sample EXEC2 program to present a menu of DISOSS functions to the 
CMS/PROFS user, and invoke appropriate EXECs to process requests. 


FO IO OO I IOI IOI I IO IO IO IOI IOI IO IO III IO IO IOI III RI IOI I IE HK 


-START _ 


CLEAR 
&BEGTYPE -ENDTYP1 
DISOSS TASKS 


Which Task do you require? 


Send a Document to DISOSS Users 
Logon to DISOSS/PS : 
Read in and send a Note to DISOSS Users 
oe a Document from DISOSS 
uit 


Enter 1, 2, 3, 4 or 9 


~ENDTYP1 
&READ VARS &ANS 
&IF .&ANS & 
&IF &ANS 
&IF &ANS 
&IF &ANS 
&IF &ANS 
&IF &ANS 
&GOTO -START 


~SENDOC 
EXEC DBTSEND 
&GOTO -START 


GOTO -START 
&GOTO -EXIT 
&GOTO -SENDOC 
&GOTO -PTHRU 
&GOTO -SNDNOTE 
&GOTO -RECEIVE 


& WW Por C- 


HRU 
EXEC DBTLOGON 
&GOTO -START 


=SNDNOTE 
~RECEIVE 
&IF &ANS EQ 3 &NXT = DBTNOTE 
&IF &ANS EQ 4 &NXT = DBTRECV 


&TYPE When you see the RDRLIST panel, enter &NXT under the "Cmd", 


&TYPE then press PF10. 
&TYPE Now press ENTER to continue. 
&READ 


EXEC RDRLIST 
&IF &RETCODE NE 28 &GOTO -START 


Sample EXECs for the CMS and PROFS User 
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&TYPE 
&TYPE Press ENTER to continue. 
READ 


& 
&GOTO -START 
EXIT 


CLEAR 
&EXIT 
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C.2 SAMPLE DBTSEND EXEC 


&TRACE ERR 


KKIKKKK IKI KKK KKK KKK KKK KKK KKK IKK KKK KKH KKKKKKKKKK KK KK KKK KK KK KKK KKK KK KK KK KKK 


* Sample EXEC2 program to take a 1403 print file, encapsulate it in an * 
* MVS job and submit to the MVS system for input to DISOSS V3. . 
* 


* 
KKK KKK IKK KIKI KI KKK KK IKK IKK HI KI HK KI KK KIKI KK IK IK KK KA KKK KKK KK KKK HK KKK KKK KKK KKK 


KIKKKKEKKK KKK KKK KK KH KKK IKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKKKEKKKKKKKKK KKK 


* Set default values. 

FHF KKK IC KK IK KH KKK KKK IKI KH HH KH KKK IH KI KKK KK KK KKK KKK KH HK KICK KKK KKK KKK KKK KKK KK 
* &RSCSVM is the name of the RSCS virtual machine. 
&RSCSVM = RJE 

* &VMNODE is the nodename of the VM system. 

&VMNODE = _ RALYDPD3 

* &MVSNODE is the nodename of the MVS system. 

&MVSNODE = RALVSMV3 

* &OSN is the DISOSS OSN name. DISOSS default is DSVHOST. 
&OSN = DSVHOST 

* &JOBNAME is first 6 characters of desired MVS jobname. 
&JOBNAME = DBTDOC 

* &JOBACCT is accounting information for MVS jobcard. 
&JOBACCT = P-032007 


KKK KIKIK KKK KKK KKK KK KKK KK KKK IKK KKK KK KKK KKK KKK KK KKK KKK KK KKKK KK KKKKKKKKKKKK 


* Direct the virtual punch to the MVS system. mn 
KIA K KI HK KI KKK KK HK KKH KKK KKK KKK KKK KKK KI KKK KKK KKK KKK KKK IKK KK KKK KKKKKKKKKKKHK 
CP SPOOL PUNCH CONT TO &RSCSVM 
CP TAG DEV PUNCH &MVSNODE JOB 10 
&DIACMD = &4 
&IF .&4 NE .TEST &SKIP 2 

CP SPOOL PUNCH CONT TO * 

&DIACMD = &5 


KIKKKKKK KKK K KEKE KKK KKK KKK KKK KKK KKK KI KKK KKK KKK KKK KEK KKK KKKKKKKKKKKKKKKKKK 


* Check that the file exists, and decide whether it has to be chopped * 
* up into 80-byte records. ‘i 


KHKKKKEKKKKK HK KKK KKK KKK KKK IKK KK IKK IKK KKK KKK KKK KKK KKK KKK KKK KKK KKKKKKKKK KK 


&IF .&1 EQ . &GOTO -PROMPT 


~CHECK 
&FN = &l 
&FT = &2 
&FM = 


&3 
&IF .&2 EQ . &FT = MEMO 
&IF .&3 EQ . &FM 
&IF .&4 NE . &IF .&DIACMD EQ . &DIACMD = &4 
STATE &FN &FT &FM 
&IF &RC EQ 0 &GOTO -GOTFILE 


~PROMPT 

&BEGTYPE 4 

Which file is to be sent? Enter ‘filename filetype filemode'. 
Defaults: none EMO A 


To quit, just press Enter. 
&READ ARGS 


Sample EXECs for the CMS and PROFS User 
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&IF .&1 EQ . &GOTO -END 
&GOTO -CHECK 


=GOT FILE 4 
LISTFILE  &FN &FT &FM (STACK FORMAT 
&IF &RC NE O &EXIT &RC 

&READ VARS &FN &FT &FM &J &LRECL 
LISTFILE &FN &FT &FM 

DROPBUF 0 


&IF &LRECL LE 160 &SKIP 2 
&TYPE Print lines must not be more than 160 chars. 
&EXIT 98 

&CDREC = 1] 

&IF &LRECL GT 80 &CDREC = 2 


KIKI IK KI KK KKK KKK KH KKK KK RIKKI IKK KK KKK KKK KKK KKK KK IKK KKK KKK KKK KKKKKKEKKKKK KKK 


* Set up the parameter card for the MVS batch program. e 


HHH HICK KKK HK HK HK HHH KH KKK HK KKH KH KK HK HK HK HK IKK KKK KK KKK KK KKK KKK HK KKK HK KK KK KK 


&CASE M 


* DSVHOST is the default OSN name in DISOSS. 
&OSN = > &LEFT OF &OSN 8 


* DISOSS userid. Default is ‘the CMS userid. 

IDENTIFY (STACK 

&READ VARS &CMSUID | 

&TYPE Enter DISOSS user name for distribution. Default is &CMSUID 
&READ STRING &USER 

&IF .&USER EQ . &USER = &CMSUID 

&USER = &LEFT OF &USER 8 


* ' C' indicates 1403 datastream as input. 
&INTYPE = &RIGHT OF C 2 


* ' 2! indicates L2DCA datastream as output. 
&OUTYPE = &RIGHT OF 2 io 


* Number of 80-byte eure: images Gepresentane one printline. 
&RECSIZE = &CDREC 


* 'A' indicates this is record type A (only type defined at present). 
&RECTYPE = A 


* 'A' indicates this is the only header card in the file. 
&PROFLAG = 


* Number of lines per page (optional). 
&PAGEL = &BLANK 
&PAGEL = &LEFT OF &PAGEL 3 


* Number of characters per line (optional). 
&PAGEW = &BLANK 
&PAGEW = &LEFT OF &PAGEW 3 


* Not used. 


&DISNAM = &BLANK 
&DISNAM = &LEFT OF &DISNAM 8 
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* Eyecatcher 
&EYECAT = HEADER 


* Document name; default is CMS filename. 

&TYPE Enter document name (maximum 15 chars.) Default is &FN 
&READ STRING &DOCNAM 

&IF .&DOCNAM EQ . &DOCNAM = &FN 

&DOCNAM = &LEFT OF &DOCNAM 15 


* DIA Command required: D = Request_Distribution, F = File. 
SUPPER VARS &DIACMD 
&IF .&DIACMD NE .D &IF .&DIACMD NE .F &DIACMD = D 


* Fille 
&RESER = = &LEFT OF &BLANK 21 


* Now build the parameter card. 

&PARMCD = &CONCAT OF &OSN &USER &INTYPE Q&OUTYPE 

&PARMCD = &CONCAT OF &PARMCD &RECSIZE &RECTYPE &PROFLAG &PAGEL &PAGEW 
&PARMCD = &CONCAT OF &PARMCD &DISNAM &EYECAT &DOCNAM &DIACMD &RESER 


KIKKK KI KKK KKK IKK KKK HK IKK KH KKK KH K KKK IKK HH KK HHH KI K KKK HKKKKHKKKKKKKKKKKKKKK 


* Punch the MVS JCL and parameter card. i 
2.2.2.2. 2.2.2.2. 8,. 2.0. 2.2.2.2, 2.2.2.8. 0.0. 2.0.5. 5.5, 8,.8.2.5.2,2,2. 8.8.0.5. 2. 2.2.8. 2,2.5.2.2 2.5.5.5.2,2,0,.5.5.5.5.5.28. 5.25.22. 2, 5.2, 2, 8,23 
&J = &SUBSTR OF &TIME 7 2 

&JOBCARD = &CONCAT OF // &JOBNAME &J &BLANK JOB &BLANK ( &JOBACCT ) 
&ROUTECD = &CONCAT OF /*ROUTE &BLANK PRINT &BLANK &VMNODE . &CMSUID 


&STACK &JOBCARD 

&STACK &ROUTECD 

&STACK //VMVSAM EXEC DBTDOCIN 
&STACK //DOCIN DD 

&STACK &PARMCD 

&STACK 

EXECIO * PUNCH 


KIKI KKK KK IKK HK IK IK KI KH IK HHH KI KK KKK IK HI HK KH KIKI KKK HH HK KKH HK KKK K HI KH KK IK He HK 


* Punch the CMS file; either one or two card images per printline. ad 
HHI K KKK IKK HHH KKK KIKI KKH IK HK KICK KKH KKK IKK KKK KKK KIKI HAH KK KKK IKKE KKKKHHKAK KKK KK 
-AGAIN 

&TRACE OFF 

EXECIO 100 DISKR &FN &FT &FM 

&EOF = &RC 

SENTRIES 

&LOOPCT = &RC 

&TRACE ERR 


&LOOP -ENDLOOP &LOOPCT 
&READ STRING &LINE 
&IF &CDREC GT 1 &SKIP 2 
EXECIO 1 PUNCH (STRING &LINE 
&GOTO -ENDLOOP 
&LINIT = &SUBSTR OF &LINE 1 80 
&LIN2 = &SUBSTR OF &LINE 81 * 
EXECIO 1 PUNCH + OTRING &LINI 
EXECIO 1 PUNCH (STRING &LIN2 
-ENDLOOP 
&IF &EOF EQ 0 &GOTO -AGAIN 
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EXECIO 1 PUNCH (STRING /* 
EXECIO 1 PUNCH (STRING // 
JOGO GOSS OIOI SOOO GIGI SGI DIES SISO SISSIES IOI II III III III 


* Tidy up and exit. bs 


FO IO IO OO OO OI IO OI IOI IOI IO IOI IOI IOI IOI RO ROI I FOR IOI IIE IO IC IK 


| | 
CP SPOOL PUNCH NOCONT CLOSE 
CP SPOOL PUNCH OFF 

CP TAG DEV PUNCH 

&EXIT 
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C.3 SAMPLE DBTLOGON EXEC 


&TRACE ERR 


KIKI KIKI KK IKK KICK KK IKK IKK KKK KKK KK HK IK KK KKK KKK KKK KK IKI KKEKKKKKKKKKKKEKKKKKKK 


* Sample EXEC2 program to invoke VM PASSTHRU in order to logon to 
* DISOSS/PS. . 


This example selects a specific port on the emulated 
3271, which allows the user interface to be simplified as follows: 

1 - the VTAM LU represented by that port can be logged on 
automatically to CICS by VIAM via the LOGAPPL parameter, so 
the user does not need to log on to CICS explicitly. 

2 - the CICS 'terminal' represented by the VTAM LU can be 
automatically connected to the DISOSS/PS transaction via the 
TRANSID parameter in the CICS TCT. Thus, the user does not 
have to enter 'DMD1' to select DISOSS/PS. 


Consequently, al the user should need to know is: 

Select '2' from the PROFS menu screen, or enter 'DBTLOGON' 

from CMS. 

When the CICS/VS logo appears, press CLEAR. 

He should then see the DISOSS/PS logon panel. 

The following VM PASSTHRU functions are available while 

logged on to DISOSS/PS: 
PA1 will suspend the session and return to CMS. 'DBTLOGON' 
will then allow the DISOSS/PS session to be resumed. 

- PA2 will terminate the CICS session, but should not be used 
until the DISOSS/PS session has been ended via PFl12. 

- PF10 will copy a screen image into file PASSTHRU DATA on 
the A-disk. Useful to take a quick copy of a DISOSS note. 


F WPS 
it i 


eee HH HHH HAKR HHH HEHEHE HEHEHE KE HE HK ES 


HH HHH K KE HHH KR He HE HKKHE HHH Ke HHH KEE 


KKK KKH KI KK KKK KKK KKK KI K KIKI KK KKK KK IKK KK KK KKK IKK KKK KK IKK KKK KKKKKKK KKK KKK 


A VM PASSTHRU NODE NAME 


NODE = RALYSNA 
* PORT ee ON EMULATED 3271 
&PORT / 
* NAME OF PASSTHRU VIRTUAL MACHINE (DEFAULT IS PVM) 
&VMID = * 
* PFKEY TO INVOKE NOTEPAD 
&NOTEPFK = 10 
* NO. OF LINES TO BE SAVED BY NOTEPAD 
®NOTELIN = 24 


* NO. OF COLS. TO BE SAVED BY NOTEPAD 
&NOTECOL = 80 


* KEY TO BE USED FOR TEMPORARY DISCONNECTION FROM PASSTHRU 
&DISC = PAI 


* KEY TO BE USED TO END PASSTHRU SESSION 
&END = PA2 


Sample EXECs for the CMS and PROFS User 


161 


* NOW INVOKE VM PASSTHRU 

CP SET MSG OFF 

DVMUSI &NODE &PORT &VMID &NOTEPFK &NOTELIN &NOTECOL &DISC &END 
CP SET MSG ON 


&EXIT 
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C.4 SAMPLE DBTNOTE EXEC 


&TRACE ERR 


FF KI KICK HH KI HK HK HI KKH KH KH KICK KKK IKK HI KK IKK KKK KKK KKKKKKK KKK KKK KK KKK KK Kk KK KK 


: Sample EXEC2 program to send a PROFS Note to DISOSS. 


* 
* 
* First part of the process is, using normal PROFS functions, to send * 
(or resend) the Note to yourself; this puts the note in your virtual * 
* 
* 
* 
* 


* 


* reader. This EXEC then reads it on to the A-disk, edits it to a form 
* suitable to DISOSS, and sends it to DISOSS by calling DBTSEND. 
* 


KIKI KI KK KK IK HK KK IKK KK IKK KH KKK KK IKK KKK KI K KKK KK KK KKK KKK KK KKK KKK KKK KK KKK 


&FN = DBTNOTE 
&FT = NOTEBOOK 
&FM = A 


* Read in the file and look for first valid line (Subject: ) 
ERASE &FN &FT &FM 

EXEC RECEIVE &1 &FN &FT &FM MONE 1 DBTNOTE 

EXECIO * DISKR &FN &FT &FM (ZONE 1 9 FIND / Subject:/ 
&READ VARS &START 


* Back up to blank line before "Subject". 
&START = &START - 1 

DROPBUF 0 

LISTFILE & FN &FT &FM (STACK ALLOC 

&IF &RC NE O &EXIT &RC 

&READ VARS &FN &FT &FM &J &J &NORECS 


* Drop last line of file 
&NORECS = &NORECS - 1 
DROPBUF 0 


* Calculate number of lines to copy 
&CPYCT = &NORECS - &START 
&CPYCT = &CPYCT + 1 


* Copy to new file, getting rid of nasty hex characters 
&STACK FE 40 FF 40 
COPY &FN &FT &FM DBTNOTE TEMP A (REP FROM &START FOR &CPYCT TRA NOPR 


* Send lovely new file to DISOSS/PS 
EXEC DBTSEND DBTNOTE TEMP A 

&TYPE NOTE has been sent to DISOSS 
ERASE DBTNOTE NOTEBOOK A 

ERASE DBTNOTE TEMP A 


-END 
EXIT 
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C.5 SAMPLE DBTRECV EXEC 


RTRACE OFF 


KHHKI KKK KK IKK KKK KK KK IKK KKH KKK KKK KKK KI IK KKH KKK HK IKK KI KKK KI KKKEKKKKIKKKKKKKKKK 


Sample EXEC2 program to take a 1403 print file sent from DISOSS, and : 


read it on to the A-disk for subsequent filing in PROFS. 


* 
* 
* : 
* Note: The VM/SP RECEIVE EXEC used here strips 1403 carriage control — 
* off the file when reading it in. A better solution is needed. 

* | : ae 
* 


KHKKKKKKKKKK KK KKK IKK KKK KKK KKK KH KKK KKK KK KKK HK KKK KKK KK KKKEKKKKKKKKKKK KKK 


STATE DBTRECV TEMP A 

&TRACE ERR 

&IF &RC EQ 0 &GOTO -RECV 
&TYPE File 'DBTRECV TEMP A' already exists. 
&TYPE Do you want to overwrite it? (y/n) 
&READ VARS &YN 
&IF .&YN NE .Y &EXIT 99 


-RECV 

ERASE DBTRECV TEMP A 

EXEC RECEIVE &1 DBTRECV TEMP A 

&TYPE File DBTRECV TEMP A is now on your A-disk 
&TYPE Use the PROFS "Soft Copy" facility to store 
&TYPE this document in the PROFS data base. 


&EXIT 
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